+12 -17

src/document/generator.ml

··· 49 49 50 50 let source_anchor locs = 51 51 match locs with 52 52 - | Some { Odoc_model.Lang.Locations.anchor = Some anchor; source_parent } -> 53 53 - Some (Url.Anchor.source_file_from_identifier source_parent ~anchor) 54 54 - | Some { Odoc_model.Lang.Locations.anchor = None; source_parent } -> 55 55 - let path = Url.Path.source_file_from_identifier source_parent in 56 56 - Some (Url.from_path path) 52 52 + | Some id -> 53 53 + Url.Anchor.from_identifier 54 54 + (id : Paths.Identifier.SourceLocation.t :> Paths.Identifier.t) 55 55 + |> Result.to_option 57 56 | _ -> None 58 57 59 58 let attach_expansion ?(status = `Default) (eq, o, e) page text = ··· 242 241 string -> 243 242 Source_page.t 244 243 end = struct 245 245 - let path id = Url.Path.source_file_from_identifier id 244 244 + let path id = Url.Path.from_identifier id 246 245 let url id = Url.from_path (path id) 247 246 248 247 let info_of_info url = function ··· 1792 1791 | `SourceDir (parent, _) -> 1793 1792 let mmap = add parent (add_dir dir) mmap in 1794 1793 dir_ancestors_add parent mmap 1795 1795 - | `SourceRoot _ -> mmap 1794 1794 + | `Page _ -> mmap 1796 1795 in 1797 1796 let file_ancestors_add ({ iv = `SourcePage (parent, _); _ } as file) 1798 1797 mmap = ··· 1804 1803 M.empty dir_pages 1805 1804 in 1806 1805 let page_of_dir (dir : SourceDir.t) (dir_children, file_children) = 1807 1807 - let url = Url.Path.source_dir_from_identifier dir in 1806 1806 + let url = Url.Path.from_identifier dir in 1808 1807 let block ?(attr = []) desc = Block.{ attr; desc } in 1809 1808 let inline ?(attr = []) desc = Inline.[ { attr; desc } ] in 1810 1809 let header = 1811 1811 - let title = inline (Text (SourceDir.name dir)) in 1810 1810 + let title = inline (Text (name dir)) in 1812 1811 Item.Heading 1813 1812 Heading.{ label = None; level = 0; title; source_anchor = None } 1814 1813 in ··· 1822 1821 in 1823 1822 let li_of_child child = 1824 1823 match child with 1825 1825 - | { iv = `SourceRoot _; _ } -> 1826 1826 - assert false (* No [`SourceRoot] is child of a [`SourceDir] *) 1824 1824 + | { iv = `Page _; _ } -> 1825 1825 + assert false (* No [`Page] is child of a [`SourceDir] *) 1827 1826 | { iv = `SourceDir (_, name); _ } -> 1828 1828 - let url = 1829 1829 - child |> Url.Path.source_dir_from_identifier |> Url.from_path 1830 1830 - in 1827 1827 + let url = child |> Url.Path.from_identifier |> Url.from_path in 1831 1828 (name, url) 1832 1829 in 1833 1830 let li_of_file_child ({ iv = `SourcePage (_, name); _ } as child) = 1834 1834 - let url = 1835 1835 - child |> Url.Path.source_file_from_identifier |> Url.from_path 1836 1836 - in 1831 1831 + let url = child |> Url.Path.from_identifier |> Url.from_path in 1837 1832 (name, url) 1838 1833 in 1839 1834 let items =

+21 -23

src/document/url.ml

··· 82 82 let ( >>= ) x f = match x with Ok x -> f x | Error _ as e -> e 83 83 84 84 module Path = struct 85 85 - type source_pv = 85 85 + type nonsrc_pv = 86 86 [ Identifier.Page.t_pv 87 87 | Identifier.Signature.t_pv 88 88 | Identifier.ClassSignature.t_pv ] 89 89 + 90 90 + type source_pv = 91 91 + [ nonsrc_pv | Identifier.SourcePage.t_pv | Identifier.SourceDir.t_pv ] 89 92 90 93 and source = source_pv Odoc_model.Paths.Identifier.id 91 94 ··· 174 177 let name = ClassTypeName.to_string name in 175 178 mk ~parent kind name 176 179 | { iv = `Result p; _ } -> from_identifier (p :> source) 180 180 + | { iv = `SourceDir (parent, name); _ } 181 181 + | { iv = `SourcePage (parent, name); _ } -> 182 182 + let parent = from_identifier (parent :> source) in 183 183 + let kind = `Page in 184 184 + mk ~parent kind name 177 185 178 186 let from_identifier p = 179 187 from_identifier 180 188 (p : [< source_pv ] Odoc_model.Paths.Identifier.id :> source) 181 181 - 182 182 - let rec source_dir_from_identifier id = 183 183 - match id.Odoc_model.Paths.Identifier.iv with 184 184 - | `SourceRoot container -> from_identifier (container :> source) 185 185 - | `SourceDir (parent, name) -> 186 186 - let parent = source_dir_from_identifier parent in 187 187 - let kind = `Page in 188 188 - mk ~parent kind name 189 189 - 190 190 - let source_file_from_identifier id = 191 191 - let (`SourcePage (parent, name)) = id.Odoc_model.Paths.Identifier.iv in 192 192 - let parent = source_dir_from_identifier parent in 193 193 - let kind = `SourcePage in 194 194 - mk ~parent kind name 195 189 196 190 let to_list url = 197 191 let rec loop acc { parent; name; kind } = ··· 369 363 happen, [`Type] may not happen either but just in case, use the 370 364 grand-parent. *) 371 365 match parent with 372 372 - | { iv = #Path.source_pv; _ } as parent -> 373 373 - mk ~kind:`Section parent str_name 374 366 | { iv = `CoreType _; _ } -> 375 367 Error (Unexpected_anchor "core_type label parent") 376 376 - | { iv = `Type (gp, _); _ } -> mk ~kind:`Section gp str_name) 377 377 - 378 378 - let source_file_from_identifier id ~anchor = 379 379 - let kind = `SourceAnchor in 380 380 - let page = Path.source_file_from_identifier id in 381 381 - { page; anchor; kind } 368 368 + | { iv = `Type (gp, _); _ } -> mk ~kind:`Section gp str_name 369 369 + | { iv = #Path.nonsrc_pv; _ } as p -> 370 370 + mk ~kind:`Section (p :> Path.source) str_name) 371 371 + | { iv = `SourceLocation (parent, loc); _ } -> 372 372 + let page = Path.from_identifier (parent :> Path.source) in 373 373 + Ok { page; kind = `SourceAnchor; anchor = DefName.to_string loc } 374 374 + | { iv = `SourceLocationMod parent; _ } -> 375 375 + let page = Path.from_identifier (parent :> Path.source) in 376 376 + Ok { page; kind = `SourceAnchor; anchor = "" } 377 377 + | { iv = `SourcePage (p, _name); _ } | { iv = `SourceDir (p, _name); _ } -> 378 378 + let page = Path.from_identifier (p :> Path.source) in 379 379 + Ok { page; kind = `Page; anchor = "" } 382 380 383 381 let polymorphic_variant ~type_ident elt = 384 382 let name_of_type_constr te =

+4 -11

src/document/url.mli

··· 29 29 30 30 type t = { kind : kind; parent : t option; name : string } 31 31 32 32 - type source_pv = 32 32 + type nonsrc_pv = 33 33 [ Identifier.Page.t_pv 34 34 | Identifier.Signature.t_pv 35 35 | Identifier.ClassSignature.t_pv ] 36 36 37 37 + type source_pv = 38 38 + [ nonsrc_pv | Identifier.SourcePage.t_pv | Identifier.SourceDir.t_pv ] 39 39 + 37 40 and source = source_pv Odoc_model.Paths.Identifier.id 38 41 39 42 val from_identifier : [< source_pv ] Odoc_model.Paths.Identifier.id -> t 40 40 - 41 41 - val source_dir_from_identifier : Odoc_model.Paths.Identifier.SourceDir.t -> t 42 42 - (** A path to a source dir. *) 43 43 - 44 44 - val source_file_from_identifier : 45 45 - Odoc_model.Paths.Identifier.SourcePage.t -> t 46 46 - (** A path to a source file. *) 47 43 48 44 val to_list : t -> (kind * string) list 49 45 ··· 92 88 } 93 89 94 90 val from_identifier : Identifier.t -> (t, Error.t) result 95 95 - 96 96 - val source_file_from_identifier : 97 97 - Odoc_model.Paths.Identifier.SourcePage.t -> anchor:string -> t 98 91 99 92 val polymorphic_variant : 100 93 type_ident:Identifier.t ->

+7 -5

src/loader/lookup_def.ml

··· 11 11 12 12 (** Project an identifier into a shape. *) 13 13 let rec shape_of_id lookup_shape : 14 14 - [< Identifier.t_pv ] Identifier.id -> Shape.t option = 14 14 + [< Identifier.NonSrc.t_pv ] Identifier.id -> Shape.t option = 15 15 let proj parent kind name = 16 16 let item = Shape.Item.make name kind in 17 17 - match shape_of_id lookup_shape (parent :> Identifier.t) with 17 17 + match shape_of_id lookup_shape (parent :> Identifier.NonSrc.t) with 18 18 | Some shape -> Some (Shape.proj shape item) 19 19 | None -> None 20 20 in ··· 29 29 (* Apply the functor to an empty signature. This doesn't seem to cause 30 30 any problem, as the shape would stop resolve on an item inside the 31 31 result of the function, which is what we want. *) 32 32 - shape_of_id lookup_shape (parent :> Identifier.t) >>= fun parent -> 32 32 + shape_of_id lookup_shape (parent :> Identifier.NonSrc.t) >>= fun parent -> 33 33 Some (Shape.app parent ~arg:(Shape.str Shape.Item.Map.empty)) 34 34 | `ModuleType (parent, name) -> 35 35 proj parent Kind.Module_type (ModuleTypeName.to_string name) ··· 69 69 Uid.unpack_uid (Uid.of_shape_uid uid) >>= fun (unit_name, id) -> 70 70 lookup_unit unit_name >>= fun (unit, _) -> 71 71 unit.Lang.Compilation_unit.source_info >>= fun sources -> 72 72 - let anchor = id >>= fun id -> Some (Uid.anchor_of_id id) in 73 73 - Some { Lang.Locations.source_parent = sources.id; anchor } 72 72 + let anchor_opt = id >>= fun id -> Some (Uid.anchor_of_id id) in 73 73 + match anchor_opt with 74 74 + | Some anchor -> Some (Paths.Identifier.Mk.source_location (sources.id,Odoc_model.Names.DefName.make_std anchor)) 75 75 + | None -> Some (Paths.Identifier.Mk.source_location_mod sources.id) 74 76 75 77 let of_cmt (cmt : Cmt_format.cmt_infos) = cmt.cmt_impl_shape 76 78

+2 -2

src/loader/lookup_def.mli

··· 4 4 5 5 val lookup_def : 6 6 (string -> (Lang.Compilation_unit.t * t) option) -> 7 7 - Identifier.t -> 8 8 - Lang.Locations.t option 7 7 + Identifier.NonSrc.t -> 8 8 + Identifier.SourceLocation.t option 9 9 (** Returns the root module containing the definition of the given identifier 10 10 and the corresponding anchor. *) 11 11

+10 -21

src/model/lang.ml

··· 16 16 17 17 open Paths 18 18 19 19 - module Locations = struct 20 20 - type t = { 21 21 - source_parent : Identifier.SourcePage.t; 22 22 - (** Correspond to where the source code is stored. Might be different 23 23 - from the root component of the identifier inside expansions. *) 24 24 - anchor : string option; 25 25 - (** Location of the definition in the implementation file. *) 26 26 - } 27 27 - end 28 28 - 19 19 + (** {3 Modules} *) 29 20 module Source_info = struct 30 21 type anchor = { anchor : string } 31 22 ··· 40 31 type t = { id : Identifier.SourcePage.t; infos : infos } 41 32 end 42 33 43 43 - (** {3 Modules} *) 44 44 - 45 34 module rec Module : sig 46 35 type decl = 47 36 | Alias of (Path.Module.t * ModuleType.simple_expansion option) ··· 49 38 50 39 type t = { 51 40 id : Identifier.Module.t; 52 52 - locs : Locations.t option; 53 53 - (** Locations might not be set when the module is artificially constructed from a functor argument. *) 41 41 + locs : Identifier.SourceLocation.t option; 42 42 + (** Identifier.SourceLocation might not be set when the module is artificially constructed from a functor argument. *) 54 43 doc : Comment.docs; 55 44 type_ : decl; 56 45 canonical : Path.Module.t option; ··· 127 116 128 117 type t = { 129 118 id : Identifier.ModuleType.t; 130 130 - locs : Locations.t option; 119 119 + locs : Identifier.SourceLocation.t option; 131 120 (** Can be [None] for module types created by a type substitution. *) 132 121 doc : Comment.docs; 133 122 canonical : Path.ModuleType.t option; ··· 268 257 269 258 type t = { 270 259 id : Identifier.Type.t; 271 271 - locs : Locations.t option; 260 260 + locs : Identifier.SourceLocation.t option; 272 261 doc : Comment.docs; 273 262 canonical : Path.Type.t option; 274 263 equation : Equation.t; ··· 283 272 module Constructor : sig 284 273 type t = { 285 274 id : Identifier.Extension.t; 286 286 - locs : Locations.t option; 275 275 + locs : Identifier.SourceLocation.t option; 287 276 doc : Comment.docs; 288 277 args : TypeDecl.Constructor.argument; 289 278 res : TypeExpr.t option; ··· 305 294 and Exception : sig 306 295 type t = { 307 296 id : Identifier.Exception.t; 308 308 - locs : Locations.t option; 297 297 + locs : Identifier.SourceLocation.t option; 309 298 doc : Comment.docs; 310 299 args : TypeDecl.Constructor.argument; 311 300 res : TypeExpr.t option; ··· 320 309 321 310 type t = { 322 311 id : Identifier.Value.t; 323 323 - locs : Locations.t option; 312 312 + locs : Identifier.SourceLocation.t option; 324 313 value : value; 325 314 doc : Comment.docs; 326 315 type_ : TypeExpr.t; ··· 337 326 338 327 type t = { 339 328 id : Identifier.Class.t; 340 340 - locs : Locations.t option; 329 329 + locs : Identifier.SourceLocation.t option; 341 330 doc : Comment.docs; 342 331 virtual_ : bool; 343 332 params : TypeDecl.param list; ··· 356 345 357 346 type t = { 358 347 id : Identifier.ClassType.t; 359 359 - locs : Locations.t option; 348 348 + locs : Identifier.SourceLocation.t option; 360 349 doc : Comment.docs; 361 350 virtual_ : bool; 362 351 params : TypeDecl.param list;

+1

src/model/names.ml

··· 141 141 module InstanceVariableName = SimpleName 142 142 module LabelName = SimpleName 143 143 module PageName = SimpleName 144 144 + module DefName = SimpleName

+2

src/model/names.mli

··· 95 95 module LabelName : SimpleName 96 96 97 97 module PageName : SimpleName 98 98 + 99 99 + module DefName : SimpleName

+32 -15

src/model/paths.ml

··· 51 51 | `Method (_, name) -> MethodName.to_string name 52 52 | `InstanceVariable (_, name) -> InstanceVariableName.to_string name 53 53 | `Label (_, name) -> LabelName.to_string name 54 54 + | `SourcePage (_, name) -> name 55 55 + | `SourceDir (_, name) -> name 56 56 + | `SourceLocation (_, anchor) -> DefName.to_string anchor 57 57 + | `SourceLocationMod x -> name_aux (x :> t) 54 58 55 59 let name : [< t_pv ] id -> string = fun n -> name_aux (n :> t) 56 60 57 61 let rec label_parent_aux = 58 62 let open Id in 59 59 - fun (n : t) -> 63 63 + fun (n : non_src) -> 60 64 match n with 61 61 - | { iv = `Result i; _ } -> label_parent_aux (i :> any) 65 65 + | { iv = `Result i; _ } -> label_parent_aux (i :> non_src) 62 66 | { iv = `CoreType _; _ } | { iv = `CoreException _; _ } -> assert false 63 67 | { iv = `Root _; _ } as p -> (p :> label_parent) 64 68 | { iv = `Page _; _ } as p -> (p :> label_parent) ··· 79 83 | { iv = `Constructor (p, _); _ } -> (p : datatype :> label_parent) 80 84 | { iv = `Field (p, _); _ } -> (p : parent :> label_parent) 81 85 82 82 - let label_parent n = label_parent_aux (n :> t) 86 86 + let label_parent n = label_parent_aux (n :> Id.non_src) 83 87 84 88 let equal x y = x.ihash = y.ihash && x.ikey = y.ikey 85 89 ··· 255 259 type t_pv = Id.container_page_pv 256 260 end 257 261 262 262 + module NonSrc = struct 263 263 + type t = Paths_types.Identifier.non_src 264 264 + type t_pv = Paths_types.Identifier.non_src_pv 265 265 + end 266 266 + 258 267 module SourceDir = struct 259 268 type t = Id.source_dir 260 269 type t_pv = Id.source_dir_pv 261 270 let equal = equal 262 271 let hash = hash 263 272 let compare = compare 264 264 - let rec name = function 265 265 - | { iv = `SourceDir (p, n); _ } -> name p ^ n ^ "/" 266 266 - | { iv = `SourceRoot _; _ } -> "./" 267 273 end 268 274 269 275 module SourcePage = struct 270 276 type t = Id.source_page 271 277 type t_pv = Id.source_page_pv 272 272 - let equal = equal 273 273 - let name { iv = `SourcePage (p, name); _ } = SourceDir.name p ^ name 274 274 - 278 278 + end 279 279 + 280 280 + module SourceLocation = struct 281 281 + type t = Paths_types.Identifier.source_location 282 282 + type t_pv = Paths_types.Identifier.source_location_pv 275 283 end 276 284 277 285 module OdocId = struct ··· 367 375 let source_page (container_page, path) = 368 376 let rec source_dir dir = 369 377 match dir with 370 370 - | [] -> 371 371 - mk_parent 372 372 - (fun () -> "") 373 373 - "sr" 374 374 - (fun (p, ()) -> `SourceRoot p) 375 375 - (container_page, ()) 378 378 + | [] -> (container_page : ContainerPage.t :> SourceDir.t) 376 379 | a :: q -> 377 380 let parent = source_dir q in 378 381 mk_parent ··· 478 481 LabelParent.t * LabelName.t -> 479 482 [> `Label of LabelParent.t * LabelName.t ] id = 480 483 mk_parent LabelName.to_string "l" (fun (p, n) -> `Label (p, n)) 484 484 + 485 485 + let source_location : 486 486 + SourcePage.t * DefName.t -> 487 487 + [> `SourceLocation of SourcePage.t * DefName.t ] id = 488 488 + mk_parent DefName.to_string "sl" (fun (p, n) -> `SourceLocation (p, n)) 489 489 + 490 490 + let source_location_mod : 491 491 + SourcePage.t -> [> `SourceLocationMod of SourcePage.t ] id = 492 492 + fun s -> 493 493 + mk_parent 494 494 + (fun () -> "__slm__") 495 495 + "" 496 496 + (fun (s, ()) -> `SourceLocationMod s) 497 497 + (s, ()) 481 498 end 482 499 end 483 500

+23 -10

src/model/paths.mli

··· 60 60 61 61 module Type : IdSig with type t = Id.type_ and type t_pv = Id.type_pv 62 62 63 63 - module SourceDir : sig 64 64 - 65 65 - include IdSig with type t = Id.source_dir and type t_pv = Id.source_dir_pv 66 66 - val name : t -> string 67 67 - end 63 63 + module SourceDir : 64 64 + IdSig with type t = Id.source_dir and type t_pv = Id.source_dir_pv 68 65 69 66 module Class : IdSig with type t = Id.class_ and type t_pv = Id.class_pv 70 67 ··· 121 118 end 122 119 module Label : 123 120 IdSig 124 124 - with type t = Paths_types.Identifier.label 125 125 - and type t_pv = Paths_types.Identifier.label_pv 121 121 + with type t = Id.label 122 122 + and type t_pv = Id.label_pv 126 123 127 124 module Page : sig 128 125 type t = Id.page ··· 134 131 type t_pv = Id.container_page_pv 135 132 end 136 133 134 134 + module NonSrc : sig 135 135 + type t = Id.non_src 136 136 + type t_pv = Id.non_src_pv 137 137 + end 138 138 + 137 139 module SourcePage : sig 138 140 type t = Id.source_page 139 141 type t_pv = Id.source_page_pv 140 140 - val name : t -> string 141 141 - val equal : t -> t -> bool 142 142 + end 143 143 + 144 144 + module SourceLocation : sig 145 145 + type t = Id.source_location 146 146 + type t_pv = Id.source_location_pv 142 147 end 148 148 + 143 149 module OdocId : sig 144 150 type t = Id.odoc_id 145 151 type t_pv = Id.odoc_id_pv ··· 177 183 178 184 val equal : ([< t_pv ] id as 'a) -> 'a -> bool 179 185 180 180 - val label_parent : [< t_pv ] id -> LabelParent.t 186 186 + val label_parent : [< NonSrc.t_pv ] id -> LabelParent.t 181 187 182 188 module Maps : sig 183 189 module Any : Map.S with type key = Any.t ··· 277 283 val label : 278 284 LabelParent.t * LabelName.t -> 279 285 [> `Label of LabelParent.t * LabelName.t ] id 286 286 + 287 287 + val source_location : 288 288 + SourcePage.t * DefName.t -> 289 289 + [> `SourceLocation of SourcePage.t * DefName.t ] id 290 290 + 291 291 + val source_location_mod : 292 292 + SourcePage.t -> [> `SourceLocationMod of SourcePage.t ] id 280 293 end 281 294 end 282 295

+22 -3

src/model/paths_types.ml

··· 18 18 and page = page_pv id 19 19 (** @canonical Odoc_model.Paths.Identifier.Page.t *) 20 20 21 21 - type source_dir_pv = 22 22 - [ `SourceRoot of container_page | `SourceDir of source_dir * string ] 21 21 + type source_dir_pv = [ container_page_pv | `SourceDir of source_dir * string ] 22 22 + (** @canonical Odoc_model.Paths.Identifier.SourceDir.t_pv *) 23 23 24 24 and source_dir = source_dir_pv id 25 25 + (** @canonical Odoc_model.Paths.Identifier.SourceDir.t *) 25 26 26 27 type source_page_pv = [ `SourcePage of source_dir * string ] 27 28 (** The second argument is the filename. ··· 30 31 31 32 type source_page = source_page_pv id 32 33 (** @canonical Odoc_model.Paths.Identifier.SourcePage.t *) 34 34 + 35 35 + type source_location_pv = 36 36 + [ `SourceLocationMod of source_page 37 37 + | `SourceLocation of source_page * DefName.t ] 38 38 + (** @canonical Odoc_model.Paths.Identifier.SourceLocation.t *) 39 39 + 40 40 + and source_location = source_location_pv id 41 41 + (** @canonical Odoc_model.Paths.Identifier.SourceLocation.t_pv *) 33 42 34 43 type odoc_id_pv = [ page_pv | `Root of container_page option * ModuleName.t ] 35 44 (** @canonical Odoc_model.Paths.Identifier.OdocId.t_pv *) ··· 177 186 and label = label_pv id 178 187 (** @canonical Odoc_model.Paths.Identifier.Label.t *) 179 188 180 180 - type any_pv = 189 189 + type non_src_pv = 181 190 [ signature_pv 182 191 | class_signature_pv 183 192 | datatype_pv ··· 199 208 | instance_variable_pv 200 209 | label_pv 201 210 | page_pv ] 211 211 + (** @canonical Odoc_model.Paths.Identifier.NonSrc.t_pv *) 212 212 + 213 213 + and non_src = non_src_pv id 214 214 + (** @canonical Odoc_model.Paths.Identifier.NonSrc.t *) 215 215 + 216 216 + type any_pv = 217 217 + [ non_src_pv 218 218 + | source_page_pv 219 219 + | source_dir_pv 220 220 + | source_location_pv ] 202 221 (** @canonical Odoc_model.Paths.Identifier.t_pv *) 203 222 204 223 and any = any_pv id

+10 -21

src/model_desc/lang_desc.ml

··· 16 16 | `Closed -> C0 "`Closed" 17 17 | `Inline -> C0 "`Inline") 18 18 19 19 - let locations = 20 20 - let open Lang.Locations in 21 21 - Record 22 22 - [ 23 23 - F ("source_parent", (fun t -> t.source_parent), sourcepage_identifier); 24 24 - F ("anchor", (fun t -> t.anchor), Option string); 25 25 - ] 26 26 - 27 19 let source_info = 28 20 let open Lang.Source_info in 29 29 - Record [ F ("id", (fun t -> t.id), sourcepage_identifier) ] 21 21 + Record [ F ("id", (fun t -> t.id), identifier) ] 30 22 31 23 (** {3 Module} *) 32 24 ··· 46 38 Record 47 39 [ 48 40 F ("id", (fun t -> t.id), identifier); 49 49 - F ("locs", (fun t -> t.locs), Option locations); 41 41 + F ("locs", (fun t -> t.locs), Option identifier); 50 42 F ("doc", (fun t -> t.doc), docs); 51 43 F ("type_", (fun t -> t.type_), module_decl); 52 44 F ··· 180 172 Record 181 173 [ 182 174 F ("id", (fun t -> t.id), identifier); 183 183 - F ("locs", (fun t -> t.locs), Option locations); 175 175 + F ("locs", (fun t -> t.locs), Option identifier); 184 176 F ("doc", (fun t -> t.doc), docs); 185 177 F 186 178 ( "canonical", ··· 370 362 Record 371 363 [ 372 364 F ("id", (fun t -> t.id), identifier); 373 373 - F ("locs", (fun t -> t.locs), Option locations); 365 365 + F ("locs", (fun t -> t.locs), Option identifier); 374 366 F ("doc", (fun t -> t.doc), docs); 375 367 F ("equation", (fun t -> t.equation), typedecl_equation); 376 368 F ··· 385 377 Record 386 378 [ 387 379 F ("id", (fun t -> t.id), identifier); 388 388 - F ("locs", (fun t -> t.locs), Option locations); 380 380 + F ("locs", (fun t -> t.locs), Option identifier); 389 381 F ("doc", (fun t -> t.doc), docs); 390 382 F ("args", (fun t -> t.args), typedecl_constructor_argument); 391 383 F ("res", (fun t -> t.res), Option typeexpr_t); ··· 409 401 Record 410 402 [ 411 403 F ("id", (fun t -> t.id), identifier); 412 412 - F ("locs", (fun t -> t.locs), Option locations); 404 404 + F ("locs", (fun t -> t.locs), Option identifier); 413 405 F ("doc", (fun t -> t.doc), docs); 414 406 F ("args", (fun t -> t.args), typedecl_constructor_argument); 415 407 F ("res", (fun t -> t.res), Option typeexpr_t); ··· 427 419 Record 428 420 [ 429 421 F ("id", (fun t -> t.id), identifier); 430 430 - F ("locs", (fun t -> t.locs), Option locations); 422 422 + F ("locs", (fun t -> t.locs), Option identifier); 431 423 F ("doc", (fun t -> t.doc), docs); 432 424 F ("type_", (fun t -> t.type_), typeexpr_t); 433 425 F ("value", (fun t -> t.value), value_value_t); ··· 451 443 Record 452 444 [ 453 445 F ("id", (fun t -> t.id), identifier); 454 454 - F ("locs", (fun t -> t.locs), Option locations); 446 446 + F ("locs", (fun t -> t.locs), Option identifier); 455 447 F ("doc", (fun t -> t.doc), docs); 456 448 F ("virtual_", (fun t -> t.virtual_), bool); 457 449 F ("params", (fun t -> t.params), List typedecl_param); ··· 474 466 Record 475 467 [ 476 468 F ("id", (fun t -> t.id), identifier); 477 477 - F ("locs", (fun t -> t.locs), Option locations); 469 469 + F ("locs", (fun t -> t.locs), Option identifier); 478 470 F ("doc", (fun t -> t.doc), docs); 479 471 F ("virtual_", (fun t -> t.virtual_), bool); 480 472 F ("params", (fun t -> t.params), List typedecl_param); ··· 712 704 F ("name", (fun t -> t.name), identifier); 713 705 F ("root", (fun t -> t.root), root); 714 706 F ("digest", (fun t -> t.digest), Digest.t); 715 715 - F 716 716 - ( "source_children", 717 717 - (fun t -> t.source_children), 718 718 - List sourcepage_identifier ); 707 707 + F ("source_children", (fun t -> t.source_children), List identifier); 719 708 ]

+17 -20

src/model_desc/paths_desc.ml

··· 37 37 let pagename = To_string PageName.to_string 38 38 39 39 let parametername = To_string ModuleName.to_string 40 40 + 41 41 + let defname = To_string DefName.to_string 40 42 end 41 43 42 44 module General_paths = struct ··· 149 151 C 150 152 ( "`Label", 151 153 ((parent :> id_t), name), 152 152 - Pair (identifier, Names.labelname) )) 154 154 + Pair (identifier, Names.labelname) ) 155 155 + | `SourceDir (parent, name) -> 156 156 + C ("`SourceDir", ((parent :> id_t), name), Pair (identifier, string)) 157 157 + | `SourcePage (parent, name) -> 158 158 + C 159 159 + ( "`SourcePage", 160 160 + ((parent :> id_t), name), 161 161 + Pair (identifier, string) ) 162 162 + | `SourceLocation (parent, name) -> 163 163 + C 164 164 + ( "`SourceLocation", 165 165 + ((parent :> id_t), name), 166 166 + Pair (identifier, Names.defname) ) 167 167 + | `SourceLocationMod parent -> 168 168 + C ("`SourceLocationMod", (parent :> id_t), identifier)) 153 169 154 170 let reference_tag : tag t = 155 171 Variant ··· 433 449 (* Indirection seems to be required to make the type open. *) 434 450 let identifier : [< Paths.Identifier.t_pv ] Paths.Identifier.id Type_desc.t = 435 451 Indirect ((fun n -> (n :> Paths.Identifier.t)), General_paths.identifier) 436 436 - 437 437 - let rec sourcedir_identifier : Paths.Identifier.SourceDir.t Type_desc.t = 438 438 - Variant 439 439 - (fun id -> 440 440 - match id.iv with 441 441 - | `SourceDir (parent, name) -> 442 442 - C ("`SourceDir", (parent, name), Pair (sourcedir_identifier, string)) 443 443 - | `SourceRoot parent -> 444 444 - C 445 445 - ( "`SourceRoot", 446 446 - (parent :> Paths.Identifier.t), 447 447 - General_paths.identifier )) 448 448 - 449 449 - let sourcepage_identifier : Paths.Identifier.SourcePage.t Type_desc.t = 450 450 - Indirect 451 451 - ( (fun id -> 452 452 - let (`SourcePage (parent, name)) = id.iv in 453 453 - (parent, name)), 454 454 - Pair (sourcedir_identifier, string) ) 455 452 456 453 let resolved_path : [< Paths.Path.Resolved.t ] Type_desc.t = 457 454 Indirect ((fun n -> (n :> General_paths.rp)), General_paths.resolved_path)

-2

src/model_desc/paths_desc.mli

··· 6 6 7 7 val identifier : [< Identifier.t_pv ] Odoc_model.Paths.Identifier.id Type_desc.t 8 8 9 9 - val sourcepage_identifier : Odoc_model.Paths.Identifier.SourcePage.t Type_desc.t 10 10 - 11 9 val resolved_path : [< Path.Resolved.t ] Type_desc.t 12 10 13 11 val path : [< Path.t ] Type_desc.t

+3 -1

src/odoc/compile.ml

··· 309 309 | { Paths.Identifier.iv = `Page _; _ } as parent_id -> 310 310 let name = Paths.Identifier.Mk.source_page (parent_id, name) in 311 311 if 312 312 - List.exists (Paths.Identifier.SourcePage.equal name) page.source_children 312 312 + List.exists 313 313 + (Paths.Identifier.equal name) 314 314 + page.source_children 313 315 then Ok (Some name) 314 316 else err_not_parent () 315 317 | { iv = `LeafPage _; _ } -> err_not_parent ())

+1 -1

src/odoc/html_page.ml

··· 37 37 source_code; 38 38 ]) 39 39 | Some { id; _ }, None -> 40 40 - let filename = Paths.Identifier.SourcePage.name id in 40 40 + let filename = Paths.Identifier.name id in 41 41 Error.raise_warning 42 42 (Error.filename_only 43 43 "The --source should be passed when generating documents from \

+19 -8

src/xref2/component.ml

··· 76 76 | ModuleType of ModuleType.expr 77 77 78 78 type t = { 79 79 - locs : Odoc_model.Lang.Locations.t option; 79 79 + locs : Odoc_model.Paths.Identifier.SourceLocation.t option; 80 80 doc : CComment.docs; 81 81 type_ : decl; 82 82 canonical : Odoc_model.Paths.Path.Module.t option; ··· 148 148 module Constructor : sig 149 149 type t = { 150 150 name : string; 151 151 - locs : Odoc_model.Lang.Locations.t option; 151 151 + locs : Odoc_model.Paths.Identifier.SourceLocation.t option; 152 152 doc : CComment.docs; 153 153 args : TypeDecl.Constructor.argument; 154 154 res : TypeExpr.t option; ··· 167 167 168 168 and Exception : sig 169 169 type t = { 170 170 - locs : Odoc_model.Lang.Locations.t option; 170 170 + locs : Odoc_model.Paths.Identifier.SourceLocation.t option; 171 171 doc : CComment.docs; 172 172 args : TypeDecl.Constructor.argument; 173 173 res : TypeExpr.t option; ··· 231 231 | TypeOf of typeof_t 232 232 233 233 type t = { 234 234 - locs : Odoc_model.Lang.Locations.t option; 234 234 + locs : Odoc_model.Paths.Identifier.SourceLocation.t option; 235 235 doc : CComment.docs; 236 236 canonical : Odoc_model.Paths.Path.ModuleType.t option; 237 237 expr : expr option; ··· 279 279 end 280 280 281 281 type t = { 282 282 - locs : Odoc_model.Lang.Locations.t option; 282 282 + locs : Odoc_model.Paths.Identifier.SourceLocation.t option; 283 283 doc : CComment.docs; 284 284 canonical : Odoc_model.Paths.Path.Type.t option; 285 285 equation : Equation.t; ··· 292 292 type value = Odoc_model.Lang.Value.value 293 293 294 294 type t = { 295 295 - locs : Odoc_model.Lang.Locations.t option; 295 295 + locs : Odoc_model.Paths.Identifier.SourceLocation.t option; 296 296 doc : CComment.docs; 297 297 type_ : TypeExpr.t; 298 298 value : value; ··· 363 363 | Arrow of TypeExpr.label option * TypeExpr.t * decl 364 364 365 365 type t = { 366 366 - locs : Odoc_model.Lang.Locations.t option; 366 366 + locs : Odoc_model.Paths.Identifier.SourceLocation.t option; 367 367 doc : CComment.docs; 368 368 virtual_ : bool; 369 369 params : TypeDecl.param list; ··· 379 379 | Signature of ClassSignature.t 380 380 381 381 type t = { 382 382 - locs : Odoc_model.Lang.Locations.t option; 382 382 + locs : Odoc_model.Paths.Identifier.SourceLocation.t option; 383 383 doc : CComment.docs; 384 384 virtual_ : bool; 385 385 params : TypeDecl.param list; ··· 1247 1247 (ExtensionName.to_string name) 1248 1248 | `Page (_, name) | `LeafPage (_, name) -> 1249 1249 Format.fprintf ppf "%s" (PageName.to_string name) 1250 1250 + | `SourcePage (p, name) | `SourceDir (p, name) -> 1251 1251 + Format.fprintf ppf "%a/%s" model_identifier 1252 1252 + (p :> Odoc_model.Paths.Identifier.t) 1253 1253 + name 1254 1254 + | `SourceLocation (p, def) -> 1255 1255 + Format.fprintf ppf "%a#%s" model_identifier 1256 1256 + (p :> Odoc_model.Paths.Identifier.t) 1257 1257 + (DefName.to_string def) 1258 1258 + | `SourceLocationMod p -> 1259 1259 + Format.fprintf ppf "%a#" model_identifier 1260 1260 + (p :> Odoc_model.Paths.Identifier.t) 1250 1261 1251 1262 and model_fragment ppf (f : Odoc_model.Paths.Fragment.t) = 1252 1263 match f with

+8 -8

src/xref2/component.mli

··· 66 66 | ModuleType of ModuleType.expr 67 67 68 68 type t = { 69 69 - locs : Odoc_model.Lang.Locations.t option; 69 69 + locs : Odoc_model.Paths.Identifier.SourceLocation.t option; 70 70 doc : CComment.docs; 71 71 type_ : decl; 72 72 canonical : Odoc_model.Paths.Path.Module.t option; ··· 134 134 module Constructor : sig 135 135 type t = { 136 136 name : string; 137 137 - locs : Odoc_model.Lang.Locations.t option; 137 137 + locs : Odoc_model.Paths.Identifier.SourceLocation.t option; 138 138 doc : CComment.docs; 139 139 args : TypeDecl.Constructor.argument; 140 140 res : TypeExpr.t option; ··· 152 152 153 153 and Exception : sig 154 154 type t = { 155 155 - locs : Odoc_model.Lang.Locations.t option; 155 155 + locs : Odoc_model.Paths.Identifier.SourceLocation.t option; 156 156 doc : CComment.docs; 157 157 args : TypeDecl.Constructor.argument; 158 158 res : TypeExpr.t option; ··· 214 214 | TypeOf of typeof_t 215 215 216 216 type t = { 217 217 - locs : Odoc_model.Lang.Locations.t option; 217 217 + locs : Odoc_model.Paths.Identifier.SourceLocation.t option; 218 218 doc : CComment.docs; 219 219 canonical : Odoc_model.Paths.Path.ModuleType.t option; 220 220 expr : expr option; ··· 261 261 end 262 262 263 263 type t = { 264 264 - locs : Odoc_model.Lang.Locations.t option; 264 264 + locs : Odoc_model.Paths.Identifier.SourceLocation.t option; 265 265 doc : CComment.docs; 266 266 canonical : Odoc_model.Paths.Path.Type.t option; 267 267 equation : Equation.t; ··· 326 326 type value = Odoc_model.Lang.Value.value 327 327 328 328 type t = { 329 329 - locs : Odoc_model.Lang.Locations.t option; 329 329 + locs : Odoc_model.Paths.Identifier.SourceLocation.t option; 330 330 doc : CComment.docs; 331 331 type_ : TypeExpr.t; 332 332 value : value; ··· 339 339 | Arrow of TypeExpr.label option * TypeExpr.t * decl 340 340 341 341 type t = { 342 342 - locs : Odoc_model.Lang.Locations.t option; 342 342 + locs : Odoc_model.Paths.Identifier.SourceLocation.t option; 343 343 doc : CComment.docs; 344 344 virtual_ : bool; 345 345 params : TypeDecl.param list; ··· 354 354 | Signature of ClassSignature.t 355 355 356 356 type t = { 357 357 - locs : Odoc_model.Lang.Locations.t option; 357 357 + locs : Odoc_model.Paths.Identifier.SourceLocation.t option; 358 358 doc : CComment.docs; 359 359 virtual_ : bool; 360 360 params : TypeDecl.param list;

+3 -3

src/xref2/env.ml

··· 18 18 open_units : string list; 19 19 lookup_unit : string -> lookup_unit_result; 20 20 lookup_page : string -> lookup_page_result; 21 21 - lookup_def : Identifier.t -> Lang.Locations.t option; 21 21 + lookup_def : Identifier.NonSrc.t -> Identifier.SourceLocation.t option; 22 22 } 23 23 24 24 let unique_id = ··· 361 361 let id = (unit.id :> Paths.Identifier.Module.t) in 362 362 let locs = 363 363 match unit.source_info with 364 364 - | Some src -> Some { Lang.Locations.source_parent = src.id; anchor = None } 364 364 + | Some src -> Some (Identifier.Mk.source_location_mod src.id) 365 365 | None -> None 366 366 in 367 367 match unit.content with ··· 425 425 result 426 426 427 427 let lookup_def id env = 428 428 - let id = (id :> Paths.Identifier.Any.t) in 428 428 + let id = (id :> Paths.Identifier.NonSrc.t) in 429 429 match env.resolver with Some r -> r.lookup_def id | None -> None 430 430 431 431 let lookup_page name env =

+2 -3

src/xref2/env.mli

··· 19 19 open_units : string list; 20 20 lookup_unit : string -> lookup_unit_result; 21 21 lookup_page : string -> lookup_page_result; 22 22 - lookup_def : Identifier.t -> Lang.Locations.t option; 22 22 + lookup_def : Identifier.NonSrc.t -> Identifier.SourceLocation.t option; 23 23 (** Lookup the source code location from an identifier. Returns 24 24 [Some (source_parent, anchor)] when definition is found. *) 25 25 } ··· 98 98 99 99 val lookup_root_module : string -> t -> root option 100 100 101 101 - val lookup_def : 102 102 - [< Identifier.t_pv ] Paths.Identifier.id -> t -> Lang.Locations.t option 101 101 + val lookup_def : Identifier.NonSrc.t -> t -> Identifier.SourceLocation.t option 103 102 (** Lookup the definition of the given identifier. Returns the root module and 104 103 the anchor. *) 105 104

+3 -2

src/xref2/link.ml

··· 8 8 end 9 9 10 10 let locations env id locs = 11 11 + let id = (id :> Id.NonSrc.t) in 11 12 match locs with Some _ as locs -> locs | None -> Env.lookup_def id env 12 13 13 14 (** Equivalent to {!Comment.synopsis}. *) ··· 360 361 let open Value in 361 362 { 362 363 t with 363 363 - locs = locations env (t.id :> Id.t) t.locs; 364 364 + locs = locations env t.id t.locs; 364 365 doc = comment_docs env parent t.doc; 365 366 type_ = type_expression env parent [] t.type_; 366 367 } ··· 541 542 else type_ 542 543 | Alias _ | ModuleType _ -> type_ 543 544 in 544 544 - let locs = (locations env (m.id :> Id.t)) m.locs in 545 545 + let locs = locations env m.id m.locs in 545 546 let doc = comment_docs env sg_id m.doc in 546 547 { m with locs; doc; type_ } 547 548