3129

Committed 01 May 2026 03:36PM UTC coverage: 71.05% (-0.1%) from 71.191%

Build # 3129

Build Type

Pull #1407

github

Committed by

web-flow

Commit Message

Merge 1ee25b106 into 27216c784

Pull Request Pull Request #1407: OxCaml: Support for unboxed named types

Coverage Stats

1 of 31 new or added lines in 10 files covered. (3.23%)

11 existing lines in 3 files now uncovered.

10411 of 14653 relevant lines covered (71.05%)

5889.64 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

23.9

/src/xref2/cpath.ml

open Odoc_model.Paths
open Odoc_model.Names

module rec Resolved : sig
  type parent =
    [ `Module of module_ | `ModuleType of module_type | `FragmentRoot ]

  and module_ =
    [ `Local of Ident.module_
    | `Gpath of Path.Resolved.Module.t
    | `Substituted of module_
    | `Subst of module_type * module_
    | `Hidden of module_
    | `Module of parent * ModuleName.t
    | `Canonical of module_ * Path.Module.t
    | `Apply of module_ * module_
    | `Alias of module_ * Cpath.module_ * module_ option
    | `OpaqueModule of module_ ]

  and module_type =
    [ `Local of Ident.module_type
    | `Substituted of module_type
    | `Gpath of Path.Resolved.ModuleType.t
    | `ModuleType of parent * ModuleTypeName.t
    | `SubstT of module_type * module_type
    | `AliasModuleType of module_type * module_type
    | `CanonicalModuleType of module_type * Path.ModuleType.t
    | `OpaqueModuleType of module_type ]

  and type_ =
    [ `Local of Ident.type_
    | `Gpath of Path.Resolved.Type.t
    | `Substituted of type_
    | `CanonicalType of type_ * Path.Type.t
    | `CoreType of TypeName.t
    | `Type of parent * TypeName.t
    | `Class of parent * TypeName.t
    | `ClassType of parent * TypeName.t
    | `Unbox of type_ ]

  and value =
    [ `Value of parent * ValueName.t | `Gpath of Path.Resolved.Value.t ]

  and class_type =
    [ `Local of Ident.type_
    | `Substituted of class_type
    | `Gpath of Path.Resolved.ClassType.t
    | `Class of parent * TypeName.t
    | `ClassType of parent * TypeName.t ]
end =
  Resolved

and Cpath : sig
  type module_ =
    [ `Resolved of Resolved.module_
    | `Substituted of module_
    | `Local of Ident.module_ * bool
    | `Identifier of Identifier.Path.Module.t * bool
    | `Root of ModuleName.t
    | `Forward of string
    | `Dot of module_ * ModuleName.t
    | `Module of Resolved.parent * ModuleName.t (* Like dot, but typed *)
    | `Apply of module_ * module_ ]

  and module_type =
    [ `Resolved of Resolved.module_type
    | `Substituted of module_type
    | `Local of Ident.module_type * bool
    | `Identifier of Identifier.ModuleType.t * bool
    | `DotMT of module_ * ModuleTypeName.t
    | `ModuleType of Resolved.parent * ModuleTypeName.t ]

  and type_ =
    [ `Resolved of Resolved.type_
    | `Substituted of type_
    | `Local of Ident.type_ * bool
    | `Identifier of Odoc_model.Paths.Identifier.Path.Type.t * bool
    | `DotT of module_ * TypeName.t
    | `Type of Resolved.parent * TypeName.t
    | `Class of Resolved.parent * TypeName.t
    | `ClassType of Resolved.parent * TypeName.t
    | `Unbox of type_ ]

  and value =
    [ `Resolved of Resolved.value
    | `DotV of module_ * ValueName.t
    | `Value of Resolved.parent * ValueName.t
    | `Identifier of Identifier.Value.t * bool ]

  and class_type =
    [ `Resolved of Resolved.class_type
    | `Substituted of class_type
    | `Local of Ident.type_ * bool
    | `Identifier of Odoc_model.Paths.Identifier.Path.ClassType.t * bool
    | `DotT of module_ * TypeName.t
    | `Class of Resolved.parent * TypeName.t
    | `ClassType of Resolved.parent * TypeName.t ]
end =
  Cpath

include Cpath

let rec is_resolved_module_substituted : Resolved.module_ -> bool = function
  | `Local _ -> false
  | `Substituted _ -> true
  | `Gpath _ -> false
  | `Subst (_a, _) -> false (* is_resolved_module_type_substituted a*)
  | `Hidden a | `Apply (a, _) | `Alias (a, _, _) | `Canonical (a, _) ->
      is_resolved_module_substituted a
  | `Module (a, _) -> is_resolved_parent_substituted a
  | `OpaqueModule a -> is_resolved_module_substituted a

and is_resolved_parent_substituted = function
  | `Module m -> is_resolved_module_substituted m
  | `ModuleType m -> is_resolved_module_type_substituted m
  | `FragmentRoot -> false

and is_resolved_module_type_substituted : Resolved.module_type -> bool =
  function
  | `Local _ -> false
  | `Substituted _ -> true
  | `Gpath _ -> false
  | `ModuleType (a, _) -> is_resolved_parent_substituted a
  | `SubstT _ -> false
  | `AliasModuleType (m1, _) -> is_resolved_module_type_substituted m1
  | `CanonicalModuleType (m, _) | `OpaqueModuleType m ->
      is_resolved_module_type_substituted m

and is_resolved_type_substituted : Resolved.type_ -> bool = function
  | `Local _ -> false
  | `CoreType _ -> false
  | `Unbox _ -> false
  | `Substituted _ -> true
  | `Gpath _ -> false
  | `CanonicalType (t, _) -> is_resolved_type_substituted t
  | `Type (a, _) | `Class (a, _) | `ClassType (a, _) ->
      is_resolved_parent_substituted a

and is_resolved_class_type_substituted : Resolved.class_type -> bool = function
  | `Local _ -> false
  | `Substituted _ -> true
  | `Gpath _ -> false
  | `Class (a, _) | `ClassType (a, _) -> is_resolved_parent_substituted a

let rec is_module_substituted : module_ -> bool = function
  | `Resolved a -> is_resolved_module_substituted a
  | `Identifier _ -> false
  | `Local _ -> false
  | `Substituted _ -> true
  | `Dot (a, _) | `Apply (a, _) -> is_module_substituted a
  | `Forward _ -> false
  | `Root _ -> false
  | `Module (a, _) -> is_resolved_parent_substituted a

let is_module_type_substituted : module_type -> bool = function
  | `Resolved a -> is_resolved_module_type_substituted a
  | `Identifier _ -> false
  | `Local _ -> false
  | `Substituted _ -> true
  | `DotMT (a, _) -> is_module_substituted a
  | `ModuleType (a, _) -> is_resolved_parent_substituted a

let is_type_substituted : type_ -> bool = function
  | `Resolved a -> is_resolved_type_substituted a
  | `Identifier _ -> false
  | `Local _ -> false
  | `Unbox _ -> false
  | `Substituted _ -> true
  | `DotT (a, _) -> is_module_substituted a
  | `Type (a, _) | `Class (a, _) | `ClassType (a, _) ->
      is_resolved_parent_substituted a

let is_class_type_substituted : class_type -> bool = function
  | `Resolved a -> is_resolved_class_type_substituted a
  | `Identifier _ -> false
  | `Local _ -> false
  | `Substituted _ -> true
  | `DotT (a, _) -> is_module_substituted a
  | `Class (a, _) | `ClassType (a, _) -> is_resolved_parent_substituted a

let rec is_module_forward : module_ -> bool = function
  | `Forward _ -> true
  | `Resolved _ -> false
  | `Root _ -> false
  | `Identifier _ -> false
  | `Local _ -> false
  | `Substituted p | `Dot (p, _) | `Apply (p, _) -> is_module_forward p
  | `Module (_, _) -> false

let rec is_module_hidden : module_ -> bool = function
  | `Resolved r -> is_resolved_module_hidden ~weak_canonical_test:false r
  | `Substituted p | `Dot (p, _) | `Apply (p, _) -> is_module_hidden p
  | `Identifier (_, b) -> b
  | `Local (_, b) -> b
  | `Forward _ -> false
  | `Root _ -> false
  | `Module (p, _) -> is_resolved_parent_hidden ~weak_canonical_test:false p

and is_resolved_module_hidden :
    weak_canonical_test:bool -> Resolved.module_ -> bool =
 fun ~weak_canonical_test ->
  let rec inner = function
    | `Local _ -> false
    | `Gpath p ->
        Odoc_model.Paths.Path.Resolved.Module.is_hidden ~weak_canonical_test p
    | `Hidden _ -> true
    | `Canonical (_, `Resolved _) -> false
    | `Canonical (p, _) -> (not weak_canonical_test) && inner p
    | `Substituted p -> inner p
    | `Module (p, _) -> is_resolved_parent_hidden ~weak_canonical_test p
    | `Subst (p1, p2) -> is_resolved_module_type_hidden p1 || inner p2
    | `Alias (p1, `Resolved p2, _) -> inner p1 && inner p2
    | `Alias (p1, _p2, _) -> inner p1
    | `Apply (p1, p2) -> inner p1 || inner p2
    | `OpaqueModule m -> inner m
  in
  inner

and is_resolved_parent_hidden :
    weak_canonical_test:bool -> Resolved.parent -> bool =
 fun ~weak_canonical_test -> function
  | `Module m -> is_resolved_module_hidden ~weak_canonical_test m
  | `ModuleType m -> is_resolved_module_type_hidden m
  | `FragmentRoot -> false

and is_module_type_hidden : module_type -> bool = function
  | `Resolved r -> is_resolved_module_type_hidden r
  | `Identifier ({ iv = `ModuleType (_, t); _ }, b) ->
      b || ModuleTypeName.is_hidden t
  | `Local (_, b) -> b
  | `Substituted p -> is_module_type_hidden p
  | `DotMT (p, _) -> is_module_hidden p
  | `ModuleType (p, _) -> is_resolved_parent_hidden ~weak_canonical_test:false p

and is_resolved_module_type_hidden : Resolved.module_type -> bool = function
  | `Local _ -> false
  | `Gpath p -> Odoc_model.Paths.Path.Resolved.(is_hidden (p :> t))
  | `Substituted p -> is_resolved_module_type_hidden p
  | `ModuleType (p, _) -> is_resolved_parent_hidden ~weak_canonical_test:false p
  | `SubstT (p1, p2) ->
      is_resolved_module_type_hidden p1 || is_resolved_module_type_hidden p2
  | `AliasModuleType (p1, p2) ->
      is_resolved_module_type_hidden p1 || is_resolved_module_type_hidden p2
  | `CanonicalModuleType (_, `Resolved _) -> false
  | `CanonicalModuleType (p, _) -> is_resolved_module_type_hidden p
  | `OpaqueModuleType m -> is_resolved_module_type_substituted m

and is_type_hidden : type_ -> bool = function
  | `Resolved r -> is_resolved_type_hidden r
  | `Identifier ({ iv = `Type (_, t); _ }, b) -> b || TypeName.is_hidden t
  | `Identifier ({ iv = `ClassType (_, t); _ }, b) -> b || TypeName.is_hidden t
  | `Identifier ({ iv = `Class (_, t); _ }, b) -> b || TypeName.is_hidden t
  | `Local (_, b) -> b
  | `Substituted p -> is_type_hidden (p :> type_)
  | `DotT (p, _) -> is_module_hidden p
  | `Unbox p -> is_type_hidden p
  | `Type (p, _) | `Class (p, _) | `ClassType (p, _) ->
      is_resolved_parent_hidden ~weak_canonical_test:false p

and is_resolved_type_hidden : Resolved.type_ -> bool = function
  | `CoreType n -> TypeName.is_hidden n
  | `Local _ -> false
  | `Gpath p -> Odoc_model.Paths.Path.Resolved.(is_hidden (p :> t))
  | `Substituted p -> is_resolved_type_hidden p
  | `CanonicalType (_, `Resolved _) -> false
  | `CanonicalType (p, _) -> is_resolved_type_hidden p
  | `Unbox p -> is_resolved_type_hidden p
  | `Type (p, _) | `Class (p, _) | `ClassType (p, _) ->
      is_resolved_parent_hidden ~weak_canonical_test:false p

and is_resolved_class_type_hidden : Resolved.class_type -> bool = function
  | `Local _ -> false
  | `Gpath p -> Odoc_model.Paths.Path.Resolved.(is_hidden (p :> t))
  | `Substituted p -> is_resolved_class_type_hidden p
  | `Class (p, _) | `ClassType (p, _) ->
      is_resolved_parent_hidden ~weak_canonical_test:false p

and is_class_type_hidden : class_type -> bool = function
  | `Resolved r -> is_resolved_class_type_hidden r
  | `Identifier (_, b) -> b
  | `Local (_, b) -> b
  | `Substituted p -> is_class_type_hidden p
  | `DotT (p, _) -> is_module_hidden p
  | `Class (p, _) | `ClassType (p, _) ->
      is_resolved_parent_hidden ~weak_canonical_test:false p

let rec resolved_module_of_resolved_module_reference :
    Reference.Resolved.Module.t -> Resolved.module_ = function
  | `Module (parent, name) ->
      `Module
        (`Module (resolved_module_of_resolved_signature_reference parent), name)
  | `Identifier x -> `Gpath (`Identifier x)
  | `Alias (_m1, _m2) -> failwith "gah"
  | `Hidden s -> `Hidden (resolved_module_of_resolved_module_reference s)

and resolved_module_of_resolved_signature_reference :
    Reference.Resolved.Signature.t -> Resolved.module_ = function
  | `Identifier ({ iv = #Identifier.Module.t_pv; _ } as i) ->
      `Gpath (`Identifier i)
  | (`Alias _ | `Module _ | `Hidden _) as r' ->
      resolved_module_of_resolved_module_reference r'
  | `ModuleType (_, n) ->
      failwith ("Not a module reference: " ^ ModuleTypeName.to_string n)
  | `AliasModuleType _ -> failwith "Not a module reference: aliasmoduletype"
  | `Identifier _ -> failwith "Not a module reference : identifier"

and module_of_module_reference : Reference.Module.t -> module_ = function
  | `Resolved r -> `Resolved (resolved_module_of_resolved_module_reference r)
  | `Root (_, _) -> failwith "unhandled"
  | `Dot
      ( (( `Resolved (`Identifier { iv = #Identifier.Module.t_pv; _ })
         | `Dot (_, _)
         | `Module (_, _) ) as parent),
        name ) ->
      `Dot (module_of_module_reference parent, ModuleName.make_std name)
  | `Module
      ( (( `Resolved (`Identifier { iv = #Identifier.Module.t_pv; _ })
         | `Dot (_, _)
         | `Module (_, _) ) as parent),
        name ) ->
      `Dot (module_of_module_reference parent, name)
  | _ -> failwith "Not a module reference"

let rec unresolve_resolved_module_path : Resolved.module_ -> module_ = function
  | `Hidden (`Gpath (`Identifier x)) -> `Identifier (x, true)
  | `Gpath (`Identifier x) ->
      let hidden =
        match x.iv with
        | `Module (_, n) -> Odoc_model.Names.ModuleName.is_hidden n
        | _ -> false
      in
      `Identifier (x, hidden)
  | `Gpath _ as x -> `Resolved x
  | `Hidden (`Local x) -> `Local (x, true)
  | `Local x -> `Local (x, false)
  | `Substituted x -> unresolve_resolved_module_path x
  | `Subst (_, x) -> unresolve_resolved_module_path x
  | `Hidden x -> unresolve_resolved_module_path x (* should assert false here *)
  | `Module (p, m) -> `Dot (unresolve_resolved_parent_path p, m)
  | `Canonical (m, _) -> unresolve_resolved_module_path m
  | `Apply (m, a) ->
      `Apply (unresolve_resolved_module_path m, unresolve_resolved_module_path a)
  | `Alias (_, `Resolved m, _) -> unresolve_resolved_module_path m
  | `Alias (_, m, _) -> m
  | `OpaqueModule m -> unresolve_resolved_module_path m

and unresolve_module_path : module_ -> module_ = function
  | `Resolved x -> unresolve_resolved_module_path x
  | `Substituted x -> unresolve_module_path x
  | `Local (_, _) as x -> x
  | `Identifier _ as x -> x
  | `Root _ as x -> x
  | `Forward _ as x -> x
  | `Dot (p, x) -> `Dot (unresolve_module_path p, x)
  | `Module (p, x) -> `Dot (unresolve_resolved_parent_path p, x)
  | `Apply (x, y) -> `Apply (unresolve_module_path x, unresolve_module_path y)

and unresolve_resolved_module_type_path : Resolved.module_type -> module_type =
  function
  | (`Local _ | `Gpath _) as p -> `Resolved p
  | `Substituted x -> unresolve_resolved_module_type_path x
  | `ModuleType (p, n) -> `DotMT (unresolve_resolved_parent_path p, n)
  | `SubstT (_, m) -> unresolve_resolved_module_type_path m
  | `AliasModuleType (_, m2) -> unresolve_resolved_module_type_path m2
  | `CanonicalModuleType (p, _) -> unresolve_resolved_module_type_path p
  | `OpaqueModuleType m -> unresolve_resolved_module_type_path m

and unresolve_resolved_parent_path : Resolved.parent -> module_ = function
  | `Module m -> unresolve_resolved_module_path m
  | `FragmentRoot | `ModuleType _ -> assert false

and unresolve_resolved_type_path : Resolved.type_ -> type_ = function
  | (`Gpath _ | `Local _ | `CoreType _) as p -> `Resolved p
  | `Substituted x -> unresolve_resolved_type_path x
  | `CanonicalType (t1, _) -> unresolve_resolved_type_path t1
  | `Type (p, n) -> `DotT (unresolve_resolved_parent_path p, n)
  | `Class (p, n) -> `DotT (unresolve_resolved_parent_path p, n)
  | `ClassType (p, n) -> `DotT (unresolve_resolved_parent_path p, n)
  | `Unbox p -> `Unbox (unresolve_resolved_type_path p)

and unresolve_resolved_class_type_path : Resolved.class_type -> class_type =
  function
  | (`Local _ | `Gpath _) as p -> `Resolved p
  | `Substituted x -> unresolve_resolved_class_type_path x
  | `Class (p, n) -> `DotT (unresolve_resolved_parent_path p, n)
  | `ClassType (p, n) -> `DotT (unresolve_resolved_parent_path p, n)

and unresolve_module_type_path : module_type -> module_type = function
  | `Resolved m -> unresolve_resolved_module_type_path m
  | y -> y

and unresolve_type_path : type_ -> type_ = function
  | `Resolved m -> (unresolve_resolved_type_path m :> type_)
  | y -> y

and unresolve_class_type_path : class_type -> class_type = function
  | `Resolved m -> unresolve_resolved_class_type_path m
  | y -> y

(*
These are left here for later. The idea is to alter a resolved path
such that all the identifiers in it are turned into fully-qualified
resolved paths. This is intended to be used to turn the 'original
path' of `module type of` expressions that was resolved in the
original context into a path that is valid in _all_ contexts.

let rec original_path_cpath : module_ -> module_ option = function
  | `Resolved p ->
      original_path_cpath (unresolve_resolved_module_path p)
  | `Root name -> Some (`Root name)
  | `Forward _ -> None
  | `Dot (p, s) -> (
      match original_path_cpath p with
      | Some p -> Some (`Dot (p, s))
      | None -> None)
  | `Apply (p1, p2) -> (
      match (original_path_cpath p1, original_path_cpath p2) with
      | Some p1', Some p2' -> Some (`Apply (p1', p2'))
      | _ -> None)
  | `Identifier (i, _) -> (
      match original_path_module_identifier i with
      | Some i -> Some (`Resolved i)
      | None -> None)
  | `Substituted p -> original_path_cpath p
  | `Local _ ->
      None
  | `Module _ ->
      None


and original_path_module_identifier :
    Odoc_model.Paths.Identifier.Path.Module.t -> Resolved.module_ option =
 fun id ->
  match id.iv with
  | `Module (sg, name) -> (
      match original_path_parent_identifier sg with
      | Some sg' -> Some (`Module (sg', name))
      | None -> None)
  | `Root _ -> Some (`Gpath (`Identifier id))
  | _ ->
      None

and original_path_parent_identifier :
    Odoc_model.Paths.Identifier.Signature.t -> Resolved.parent option =
 fun id ->
  match id with
  | { iv = `Module _ | `Root _ | `Parameter _ | `Result _; _ } as mid -> (
      match original_path_module_identifier mid with
      | Some m -> Some (`Module m)
      | None -> None)
  | { iv = `ModuleType _; _ } as mtid -> (
      match original_path_module_type_identifier mtid with
      | Some m -> Some (`ModuleType m)
      | None -> None)

and original_path_module_type_identifier :
    Odoc_model.Paths.Identifier.ModuleType.t -> Resolved.module_type option =
 fun id ->
  match id.iv with
  | `ModuleType (sg, name) -> (
      match original_path_parent_identifier sg with
      | Some sg' -> Some (`ModuleType (sg', name))
      | None -> None)
*)

1	open Odoc_model.Paths
2	open Odoc_model.Names
3
4	module rec Resolved : sig
5	type parent =
6	[ `Module of module_ \| `ModuleType of module_type \| `FragmentRoot ]
7
8	and module_ =
9	[ `Local of Ident.module_
10	\| `Gpath of Path.Resolved.Module.t
11	\| `Substituted of module_
12	\| `Subst of module_type * module_
13	\| `Hidden of module_
14	\| `Module of parent * ModuleName.t
15	\| `Canonical of module_ * Path.Module.t
16	\| `Apply of module_ * module_
17	\| `Alias of module_ * Cpath.module_ * module_ option
18	\| `OpaqueModule of module_ ]
19
20	and module_type =
21	[ `Local of Ident.module_type
22	\| `Substituted of module_type
23	\| `Gpath of Path.Resolved.ModuleType.t
24	\| `ModuleType of parent * ModuleTypeName.t
25	\| `SubstT of module_type * module_type
26	\| `AliasModuleType of module_type * module_type
27	\| `CanonicalModuleType of module_type * Path.ModuleType.t
28	\| `OpaqueModuleType of module_type ]
29
30	and type_ =
31	[ `Local of Ident.type_
32	\| `Gpath of Path.Resolved.Type.t
33	\| `Substituted of type_
34	\| `CanonicalType of type_ * Path.Type.t
35	\| `CoreType of TypeName.t
36	\| `Type of parent * TypeName.t
37	\| `Class of parent * TypeName.t
38	\| `ClassType of parent * TypeName.t
39	\| `Unbox of type_ ]
40
41	and value =
42	[ `Value of parent * ValueName.t \| `Gpath of Path.Resolved.Value.t ]
43
44	and class_type =
45	[ `Local of Ident.type_
46	\| `Substituted of class_type
47	\| `Gpath of Path.Resolved.ClassType.t
48	\| `Class of parent * TypeName.t
49	\| `ClassType of parent * TypeName.t ]
50	end =
51	Resolved
52
53	and Cpath : sig
54	type module_ =
55	[ `Resolved of Resolved.module_
56	\| `Substituted of module_
57	\| `Local of Ident.module_ * bool
58	\| `Identifier of Identifier.Path.Module.t * bool
59	\| `Root of ModuleName.t
60	\| `Forward of string
61	\| `Dot of module_ * ModuleName.t
62	\| `Module of Resolved.parent * ModuleName.t (* Like dot, but typed *)
63	\| `Apply of module_ * module_ ]
64
65	and module_type =
66	[ `Resolved of Resolved.module_type
67	\| `Substituted of module_type
68	\| `Local of Ident.module_type * bool
69	\| `Identifier of Identifier.ModuleType.t * bool
70	\| `DotMT of module_ * ModuleTypeName.t
71	\| `ModuleType of Resolved.parent * ModuleTypeName.t ]
72
73	and type_ =
74	[ `Resolved of Resolved.type_
75	\| `Substituted of type_
76	\| `Local of Ident.type_ * bool
77	\| `Identifier of Odoc_model.Paths.Identifier.Path.Type.t * bool
78	\| `DotT of module_ * TypeName.t
79	\| `Type of Resolved.parent * TypeName.t
80	\| `Class of Resolved.parent * TypeName.t
81	\| `ClassType of Resolved.parent * TypeName.t
82	\| `Unbox of type_ ]
83
84	and value =
85	[ `Resolved of Resolved.value
86	\| `DotV of module_ * ValueName.t
87	\| `Value of Resolved.parent * ValueName.t
88	\| `Identifier of Identifier.Value.t * bool ]
89
90	and class_type =
91	[ `Resolved of Resolved.class_type
92	\| `Substituted of class_type
93	\| `Local of Ident.type_ * bool
94	\| `Identifier of Odoc_model.Paths.Identifier.Path.ClassType.t * bool
95	\| `DotT of module_ * TypeName.t
96	\| `Class of Resolved.parent * TypeName.t
97	\| `ClassType of Resolved.parent * TypeName.t ]
98	end =
99	Cpath
100
101	include Cpath
102
103	let rec is_resolved_module_substituted : Resolved.module_ -> bool = function
104	\| `Local _ -> false	×
105	\| `Substituted _ -> true	15✔
106	\| `Gpath _ -> false	22✔
107	\| `Subst (_a, _) -> false (* is_resolved_module_type_substituted a*)	1✔
108	\| `Hidden a \| `Apply (a, _) \| `Alias (a, _, _) \| `Canonical (a, _) ->	×
109	is_resolved_module_substituted a
110	\| `Module (a, _) -> is_resolved_parent_substituted a	2✔
111	\| `OpaqueModule a -> is_resolved_module_substituted a	×
112
113	and is_resolved_parent_substituted = function
114	\| `Module m -> is_resolved_module_substituted m	24✔
115	\| `ModuleType m -> is_resolved_module_type_substituted m	×
116	\| `FragmentRoot -> false	1✔
117
118	and is_resolved_module_type_substituted : Resolved.module_type -> bool =
119	function
120	\| `Local _ -> false	×
121	\| `Substituted _ -> true	×
122	\| `Gpath _ -> false	23✔
123	\| `ModuleType (a, _) -> is_resolved_parent_substituted a	23✔
124	\| `SubstT _ -> false	×
125	\| `AliasModuleType (m1, _) -> is_resolved_module_type_substituted m1	2✔
126	\| `CanonicalModuleType (m, _) \| `OpaqueModuleType m ->	6✔
127	is_resolved_module_type_substituted m
128
129	and is_resolved_type_substituted : Resolved.type_ -> bool = function
130	\| `Local _ -> false	×
131	\| `CoreType _ -> false	×
NEW 132	\| `Unbox _ -> false	×
133	\| `Substituted _ -> true	×
134	\| `Gpath _ -> false	×
135	\| `CanonicalType (t, _) -> is_resolved_type_substituted t	×
136	\| `Type (a, _) \| `Class (a, _) \| `ClassType (a, _) ->	×
137	is_resolved_parent_substituted a
138
139	and is_resolved_class_type_substituted : Resolved.class_type -> bool = function
140	\| `Local _ -> false	×
141	\| `Substituted _ -> true	×
142	\| `Gpath _ -> false	×
143	\| `Class (a, _) \| `ClassType (a, _) -> is_resolved_parent_substituted a	×
144
145	let rec is_module_substituted : module_ -> bool = function
146	\| `Resolved a -> is_resolved_module_substituted a	16✔
147	\| `Identifier _ -> false	×
148	\| `Local _ -> false	×
149	\| `Substituted _ -> true	1✔
150	\| `Dot (a, _) \| `Apply (a, _) -> is_module_substituted a	×
151	\| `Forward _ -> false	×
152	\| `Root _ -> false	1✔
153	\| `Module (a, _) -> is_resolved_parent_substituted a	×
154
155	let is_module_type_substituted : module_type -> bool = function
156	\| `Resolved a -> is_resolved_module_type_substituted a	46✔
157	\| `Identifier _ -> false	8✔
158	\| `Local _ -> false	×
159	\| `Substituted _ -> true	×
160	\| `DotMT (a, _) -> is_module_substituted a	18✔
161	\| `ModuleType (a, _) -> is_resolved_parent_substituted a	×
162
163	let is_type_substituted : type_ -> bool = function
164	\| `Resolved a -> is_resolved_type_substituted a	×
165	\| `Identifier _ -> false	×
166	\| `Local _ -> false	×
NEW 167	\| `Unbox _ -> false	×
168	\| `Substituted _ -> true	×
169	\| `DotT (a, _) -> is_module_substituted a	×
170	\| `Type (a, _) \| `Class (a, _) \| `ClassType (a, _) ->	×
171	is_resolved_parent_substituted a
172
173	let is_class_type_substituted : class_type -> bool = function
174	\| `Resolved a -> is_resolved_class_type_substituted a	×
175	\| `Identifier _ -> false	×
176	\| `Local _ -> false	×
177	\| `Substituted _ -> true	×
178	\| `DotT (a, _) -> is_module_substituted a	×
179	\| `Class (a, _) \| `ClassType (a, _) -> is_resolved_parent_substituted a	×
180
181	let rec is_module_forward : module_ -> bool = function
182	\| `Forward _ -> true	×
183	\| `Resolved _ -> false	×
184	\| `Root _ -> false	9✔
185	\| `Identifier _ -> false	×
186	\| `Local _ -> false	×
187	\| `Substituted p \| `Dot (p, _) \| `Apply (p, _) -> is_module_forward p	×
188	\| `Module (_, _) -> false	×
189
190	let rec is_module_hidden : module_ -> bool = function
191	\| `Resolved r -> is_resolved_module_hidden ~weak_canonical_test:false r	×
192	\| `Substituted p \| `Dot (p, _) \| `Apply (p, _) -> is_module_hidden p	×
193	\| `Identifier (_, b) -> b	×
194	\| `Local (_, b) -> b	×
195	\| `Forward _ -> false	×
196	\| `Root _ -> false	×
197	\| `Module (p, _) -> is_resolved_parent_hidden ~weak_canonical_test:false p	×
198
199	and is_resolved_module_hidden :
200	weak_canonical_test:bool -> Resolved.module_ -> bool =
201	fun ~weak_canonical_test ->
202	let rec inner = function	44,711✔
203	\| `Local _ -> false	×
204	\| `Gpath p ->	21,113✔
205	Odoc_model.Paths.Path.Resolved.Module.is_hidden ~weak_canonical_test p
206	\| `Hidden _ -> true	138✔
207	\| `Canonical (_, `Resolved _) -> false	135✔
208	\| `Canonical (p, _) -> (not weak_canonical_test) && inner p	×
209	\| `Substituted p -> inner p	8✔
210	\| `Module (p, _) -> is_resolved_parent_hidden ~weak_canonical_test p	21,085✔
211	\| `Subst (p1, p2) -> is_resolved_module_type_hidden p1 \|\| inner p2	×
212	\| `Alias (p1, `Resolved p2, _) -> inner p1 && inner p2	×
213	\| `Alias (p1, _p2, _) -> inner p1	1,423,012✔
214	\| `Apply (p1, p2) -> inner p1 \|\| inner p2	×
215	\| `OpaqueModule m -> inner m	×
216	in
217	inner
218
219	and is_resolved_parent_hidden :
220	weak_canonical_test:bool -> Resolved.parent -> bool =
221	fun ~weak_canonical_test -> function
222	\| `Module m -> is_resolved_module_hidden ~weak_canonical_test m	21,098✔
223	\| `ModuleType m -> is_resolved_module_type_hidden m	×
224	\| `FragmentRoot -> false	×
225
226	and is_module_type_hidden : module_type -> bool = function
227	\| `Resolved r -> is_resolved_module_type_hidden r	×
228	\| `Identifier ({ iv = `ModuleType (_, t); _ }, b) ->	×
229	b \|\| ModuleTypeName.is_hidden t	×
230	\| `Local (_, b) -> b	×
231	\| `Substituted p -> is_module_type_hidden p	×
232	\| `DotMT (p, _) -> is_module_hidden p	×
233	\| `ModuleType (p, _) -> is_resolved_parent_hidden ~weak_canonical_test:false p	×
234
235	and is_resolved_module_type_hidden : Resolved.module_type -> bool = function
236	\| `Local _ -> false	×
237	\| `Gpath p -> Odoc_model.Paths.Path.Resolved.(is_hidden (p :> t))	×
238	\| `Substituted p -> is_resolved_module_type_hidden p	×
239	\| `ModuleType (p, _) -> is_resolved_parent_hidden ~weak_canonical_test:false p	4✔
240	\| `SubstT (p1, p2) ->	×
241	is_resolved_module_type_hidden p1 \|\| is_resolved_module_type_hidden p2	×
242	\| `AliasModuleType (p1, p2) ->	×
243	is_resolved_module_type_hidden p1 \|\| is_resolved_module_type_hidden p2	×
244	\| `CanonicalModuleType (_, `Resolved _) -> false	×
245	\| `CanonicalModuleType (p, _) -> is_resolved_module_type_hidden p	×
246	\| `OpaqueModuleType m -> is_resolved_module_type_substituted m	×
247
248	and is_type_hidden : type_ -> bool = function
249	\| `Resolved r -> is_resolved_type_hidden r	×
250	\| `Identifier ({ iv = `Type (_, t); _ }, b) -> b \|\| TypeName.is_hidden t	×
251	\| `Identifier ({ iv = `ClassType (_, t); _ }, b) -> b \|\| TypeName.is_hidden t	×
252	\| `Identifier ({ iv = `Class (_, t); _ }, b) -> b \|\| TypeName.is_hidden t	×
253	\| `Local (_, b) -> b	×
254	\| `Substituted p -> is_type_hidden (p :> type_)	×
255	\| `DotT (p, _) -> is_module_hidden p	×
NEW 256	\| `Unbox p -> is_type_hidden p	×
UNCOV 257	\| `Type (p, _) \| `Class (p, _) \| `ClassType (p, _) ->	×
258	is_resolved_parent_hidden ~weak_canonical_test:false p
259
260	and is_resolved_type_hidden : Resolved.type_ -> bool = function
261	\| `CoreType n -> TypeName.is_hidden n	×
262	\| `Local _ -> false	×
263	\| `Gpath p -> Odoc_model.Paths.Path.Resolved.(is_hidden (p :> t))	9✔
264	\| `Substituted p -> is_resolved_type_hidden p	×
265	\| `CanonicalType (_, `Resolved _) -> false	×
266	\| `CanonicalType (p, _) -> is_resolved_type_hidden p	×
NEW 267	\| `Unbox p -> is_resolved_type_hidden p	×
UNCOV 268	\| `Type (p, _) \| `Class (p, _) \| `ClassType (p, _) ->	×
269	is_resolved_parent_hidden ~weak_canonical_test:false p
270
271	and is_resolved_class_type_hidden : Resolved.class_type -> bool = function
272	\| `Local _ -> false	×
273	\| `Gpath p -> Odoc_model.Paths.Path.Resolved.(is_hidden (p :> t))	×
274	\| `Substituted p -> is_resolved_class_type_hidden p	×
275	\| `Class (p, _) \| `ClassType (p, _) ->	×
276	is_resolved_parent_hidden ~weak_canonical_test:false p
277
278	and is_class_type_hidden : class_type -> bool = function
279	\| `Resolved r -> is_resolved_class_type_hidden r	×
280	\| `Identifier (_, b) -> b	×
281	\| `Local (_, b) -> b	×
282	\| `Substituted p -> is_class_type_hidden p	×
283	\| `DotT (p, _) -> is_module_hidden p	×
284	\| `Class (p, _) \| `ClassType (p, _) ->	×
285	is_resolved_parent_hidden ~weak_canonical_test:false p
286
287	let rec resolved_module_of_resolved_module_reference :
288	Reference.Resolved.Module.t -> Resolved.module_ = function
289	\| `Module (parent, name) ->	×
290	`Module
291	(`Module (resolved_module_of_resolved_signature_reference parent), name)	×
292	\| `Identifier x -> `Gpath (`Identifier x)	×
293	\| `Alias (_m1, _m2) -> failwith "gah"	×
294	\| `Hidden s -> `Hidden (resolved_module_of_resolved_module_reference s)	×
295
296	and resolved_module_of_resolved_signature_reference :
297	Reference.Resolved.Signature.t -> Resolved.module_ = function
298	\| `Identifier ({ iv = #Identifier.Module.t_pv; _ } as i) ->	×
299	`Gpath (`Identifier i)
300	\| (`Alias _ \| `Module _ \| `Hidden _) as r' ->	×
301	resolved_module_of_resolved_module_reference r'
302	\| `ModuleType (_, n) ->	×
303	failwith ("Not a module reference: " ^ ModuleTypeName.to_string n)	×
304	\| `AliasModuleType _ -> failwith "Not a module reference: aliasmoduletype"	×
305	\| `Identifier _ -> failwith "Not a module reference : identifier"	×
306
307	and module_of_module_reference : Reference.Module.t -> module_ = function
308	\| `Resolved r -> `Resolved (resolved_module_of_resolved_module_reference r)	×
309	\| `Root (_, _) -> failwith "unhandled"	×
310	\| `Dot	×
311	( (( `Resolved (`Identifier { iv = #Identifier.Module.t_pv; _ })	×
312	\| `Dot (_, _)	×
313	\| `Module (_, _) ) as parent),	×
314	name ) ->
315	`Dot (module_of_module_reference parent, ModuleName.make_std name)	×
316	\| `Module	×
317	( (( `Resolved (`Identifier { iv = #Identifier.Module.t_pv; _ })	×
318	\| `Dot (_, _)	×
319	\| `Module (_, _) ) as parent),	×
320	name ) ->
321	`Dot (module_of_module_reference parent, name)	×
322	\| _ -> failwith "Not a module reference"	×
323
324	let rec unresolve_resolved_module_path : Resolved.module_ -> module_ = function
325	\| `Hidden (`Gpath (`Identifier x)) -> `Identifier (x, true)	202✔
326	\| `Gpath (`Identifier x) ->	30,466✔
327	let hidden =
328	match x.iv with
329	\| `Module (_, n) -> Odoc_model.Names.ModuleName.is_hidden n	755✔
330	\| _ -> false	29,711✔
331	in
332	`Identifier (x, hidden)
333	\| `Gpath _ as x -> `Resolved x	×
334	\| `Hidden (`Local x) -> `Local (x, true)	2✔
335	\| `Local x -> `Local (x, false)	23✔
336	\| `Substituted x -> unresolve_resolved_module_path x	2✔
337	\| `Subst (_, x) -> unresolve_resolved_module_path x	×
338	\| `Hidden x -> unresolve_resolved_module_path x (* should assert false here *)	×
339	\| `Module (p, m) -> `Dot (unresolve_resolved_parent_path p, m)	558✔
340	\| `Canonical (m, _) -> unresolve_resolved_module_path m	200✔
341	\| `Apply (m, a) ->	2✔
342	`Apply (unresolve_resolved_module_path m, unresolve_resolved_module_path a)	2✔
343	\| `Alias (_, `Resolved m, _) -> unresolve_resolved_module_path m	×
344	\| `Alias (_, m, _) -> m	503✔
345	\| `OpaqueModule m -> unresolve_resolved_module_path m	1✔
346
347	and unresolve_module_path : module_ -> module_ = function
348	\| `Resolved x -> unresolve_resolved_module_path x	5✔
349	\| `Substituted x -> unresolve_module_path x	×
350	\| `Local (_, _) as x -> x	×
351	\| `Identifier _ as x -> x	147,515✔
352	\| `Root _ as x -> x	×
353	\| `Forward _ as x -> x	×
354	\| `Dot (p, x) -> `Dot (unresolve_module_path p, x)	12✔
355	\| `Module (p, x) -> `Dot (unresolve_resolved_parent_path p, x)	29,719✔
356	\| `Apply (x, y) -> `Apply (unresolve_module_path x, unresolve_module_path y)	×
357
358	and unresolve_resolved_module_type_path : Resolved.module_type -> module_type =
359	function
360	\| (`Local _ \| `Gpath _) as p -> `Resolved p	×
361	\| `Substituted x -> unresolve_resolved_module_type_path x	×
362	\| `ModuleType (p, n) -> `DotMT (unresolve_resolved_parent_path p, n)	14✔
363	\| `SubstT (_, m) -> unresolve_resolved_module_type_path m	×
364	\| `AliasModuleType (_, m2) -> unresolve_resolved_module_type_path m2	1✔
365	\| `CanonicalModuleType (p, _) -> unresolve_resolved_module_type_path p	×
366	\| `OpaqueModuleType m -> unresolve_resolved_module_type_path m	15✔
367
368	and unresolve_resolved_parent_path : Resolved.parent -> module_ = function
369	\| `Module m -> unresolve_resolved_module_path m	30,294✔
370	\| `FragmentRoot \| `ModuleType _ -> assert false
371
372	and unresolve_resolved_type_path : Resolved.type_ -> type_ = function
373	\| (`Gpath _ \| `Local _ \| `CoreType _) as p -> `Resolved p	×
374	\| `Substituted x -> unresolve_resolved_type_path x	×
375	\| `CanonicalType (t1, _) -> unresolve_resolved_type_path t1	×
376	\| `Type (p, n) -> `DotT (unresolve_resolved_parent_path p, n)	3✔
377	\| `Class (p, n) -> `DotT (unresolve_resolved_parent_path p, n)	×
378	\| `ClassType (p, n) -> `DotT (unresolve_resolved_parent_path p, n)	×
NEW 379	\| `Unbox p -> `Unbox (unresolve_resolved_type_path p)	×
380
381	and unresolve_resolved_class_type_path : Resolved.class_type -> class_type =
382	function
383	\| (`Local _ \| `Gpath _) as p -> `Resolved p	×
384	\| `Substituted x -> unresolve_resolved_class_type_path x	×
385	\| `Class (p, n) -> `DotT (unresolve_resolved_parent_path p, n)	×
386	\| `ClassType (p, n) -> `DotT (unresolve_resolved_parent_path p, n)	×
387
388	and unresolve_module_type_path : module_type -> module_type = function
389	\| `Resolved m -> unresolve_resolved_module_type_path m	×
390	\| y -> y	×
391
392	and unresolve_type_path : type_ -> type_ = function
393	\| `Resolved m -> (unresolve_resolved_type_path m :> type_)	×
394	\| y -> y	×
395
396	and unresolve_class_type_path : class_type -> class_type = function
397	\| `Resolved m -> unresolve_resolved_class_type_path m	×
398	\| y -> y	×
399
400	(*
401	These are left here for later. The idea is to alter a resolved path
402	such that all the identifiers in it are turned into fully-qualified
403	resolved paths. This is intended to be used to turn the 'original
404	path' of `module type of` expressions that was resolved in the
405	original context into a path that is valid in _all_ contexts.
406
407	let rec original_path_cpath : module_ -> module_ option = function
408	\| `Resolved p ->
409	original_path_cpath (unresolve_resolved_module_path p)
410	\| `Root name -> Some (`Root name)
411	\| `Forward _ -> None
412	\| `Dot (p, s) -> (
413	match original_path_cpath p with
414	\| Some p -> Some (`Dot (p, s))
415	\| None -> None)
416	\| `Apply (p1, p2) -> (
417	match (original_path_cpath p1, original_path_cpath p2) with
418	\| Some p1', Some p2' -> Some (`Apply (p1', p2'))
419	\| _ -> None)
420	\| `Identifier (i, _) -> (
421	match original_path_module_identifier i with
422	\| Some i -> Some (`Resolved i)
423	\| None -> None)
424	\| `Substituted p -> original_path_cpath p
425	\| `Local _ ->
426	None
427	\| `Module _ ->
428	None
429
430
431	and original_path_module_identifier :
432	Odoc_model.Paths.Identifier.Path.Module.t -> Resolved.module_ option =
433	fun id ->
434	match id.iv with
435	\| `Module (sg, name) -> (
436	match original_path_parent_identifier sg with
437	\| Some sg' -> Some (`Module (sg', name))
438	\| None -> None)
439	\| `Root _ -> Some (`Gpath (`Identifier id))
440	\| _ ->
441	None
442
443	and original_path_parent_identifier :
444	Odoc_model.Paths.Identifier.Signature.t -> Resolved.parent option =
445	fun id ->
446	match id with
447	\| { iv = `Module _ \| `Root _ \| `Parameter _ \| `Result _; _ } as mid -> (
448	match original_path_module_identifier mid with
449	\| Some m -> Some (`Module m)
450	\| None -> None)
451	\| { iv = `ModuleType _; _ } as mtid -> (
452	match original_path_module_type_identifier mtid with
453	\| Some m -> Some (`ModuleType m)
454	\| None -> None)
455
456	and original_path_module_type_identifier :
457	Odoc_model.Paths.Identifier.ModuleType.t -> Resolved.module_type option =
458	fun id ->
459	match id.iv with
460	\| `ModuleType (sg, name) -> (
461	match original_path_parent_identifier sg with
462	\| Some sg' -> Some (`ModuleType (sg', name))
463	\| None -> None)
464	*)

ocaml / odoc / 3129

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous