Stable anchors in links to implementation.

src/.ocamlformat-ignore

@@ -5,10 +5,12 @@ loader/cmi.mli
 loader/cmt.ml
 loader/cmti.ml
 loader/doc_attr.ml
-loader/local_jmp.ml
+loader/implementation.ml
 loader/lookup_def.ml
-loader/uid.ml
-loader/uid.mli
+loader/lookup_def.mli
+loader/odoc_loader.ml
 syntax_highlighter/syntax_highlighter.ml
 model/*.cppo.ml
-html_support_files/*.ml
+html_support_files/*.ml
+xref2/shape_tools.*
+

src/document/ML.mli

@@ -26,6 +26,7 @@ val source_tree : Lang.SourceTree.t -> Types.Document.t list
 
 val source_page :
   Identifier.SourcePage.t ->
+  Syntax_highlighter.infos ->
   Lang.Source_info.infos ->
   string ->
   Types.Document.t

src/document/dune

@@ -12,4 +12,4 @@
  (public_name odoc.document)
  (instrumentation
   (backend bisect_ppx))
- (libraries odoc_model fpath astring))
+ (libraries odoc_model fpath astring syntax_highlighter))

src/document/generator.ml

@@ -23,6 +23,12 @@ open O.Infix
 
 let tag tag t = O.span ~attr:tag t
 
+let rec filter_map acc f = function
+  | hd :: tl ->
+      let acc = match f hd with Some x -> x :: acc | None -> acc in
+      filter_map acc f tl
+  | [] -> List.rev acc
+
 let label t =
   match t with
   | Odoc_model.Lang.TypeExpr.Label s -> tag "label" (O.txt s)
@@ -239,24 +245,37 @@ module Make (Syntax : SYNTAX) = struct
     val url : Paths.Identifier.SourcePage.t -> Url.t
     val source :
       Paths.Identifier.SourcePage.t ->
+      Syntax_highlighter.infos ->
       Lang.Source_info.infos ->
       string ->
       Source_page.t
   end = struct
     let path id = Url.Path.from_identifier id
     let url id = Url.from_path (path id)
 
-    let info_of_info url = function
-      | Lang.Source_info.Syntax s -> Source_page.Syntax s
-      | Local_jmp (Occurence { anchor }) ->
-          Link (Url.Anchor.source_anchor url anchor)
-      | Local_jmp (Def string) -> Anchor string
-
-    let source id infos source_code =
+    let info_of_info : Lang.Source_info.annotation -> Source_page.info option =
+      function
+      | Value id -> (
+          match Url.Anchor.from_identifier (id :> Paths.Identifier.t) with
+          | Ok url -> Some (Link url)
+          | Error _ -> None)
+      | Definition id -> (
+          match id.iv with
+          | `SourceLocation (_, def) -> Some (Anchor (DefName.to_string def))
+          | `SourceLocationInternal (_, local) ->
+              Some (Anchor (LocalName.to_string local))
+          | _ -> None)
+
+    let source id syntax_info infos source_code =
       let url = path id in
-      let mapper (info, loc) = (info_of_info url info, loc) in
-      let infos = List.map mapper infos in
-      let contents = Impl.impl ~infos source_code in
+      let mapper (info, loc) =
+        match info_of_info info with Some x -> Some (x, loc) | None -> None
+      in
+      let infos = filter_map [] mapper infos in
+      let syntax_info =
+        List.map (fun (ty, loc) -> (Source_page.Syntax ty, loc)) syntax_info
+      in
+      let contents = Impl.impl ~infos:(infos @ syntax_info) source_code in
       { Source_page.url; contents }
   end
 
@@ -1863,6 +1882,6 @@ module Make (Syntax : SYNTAX) = struct
 
   include Page
 
-  let source_page id infos source_code =
-    Document.Source_page (Source_page.source id infos source_code)
+  let source_page id syntax_info infos source_code =
+    Document.Source_page (Source_page.source id syntax_info infos source_code)
 end

src/document/generator_signatures.ml

@@ -110,6 +110,7 @@ module type GENERATOR = sig
 
   val source_page :
     Odoc_model.Paths.Identifier.SourcePage.t ->
+    Syntax_highlighter.infos ->
     Lang.Source_info.infos ->
     string ->
     Document.t

src/document/reason.mli

@@ -26,6 +26,7 @@ val source_tree : Lang.SourceTree.t -> Types.Document.t list
 
 val source_page :
   Identifier.SourcePage.t ->
+  Syntax_highlighter.infos ->
   Lang.Source_info.infos ->
   string ->
   Types.Document.t

src/document/url.ml

@@ -3,15 +3,6 @@ open Odoc_model.Paths
 open Odoc_model.Names
 module Root = Odoc_model.Root
 
-let functor_arg_pos : Odoc_model.Paths.Identifier.FunctorParameter.t -> int =
-  let open Odoc_model.Paths.Identifier in
-  fun { iv = `Parameter (p, _); _ } ->
-    let rec inner_sig = function
-      | `Result { iv = p; _ } -> 1 + inner_sig p
-      | `Module _ | `ModuleType _ | `Root _ | `Parameter _ -> 1
-    in
-    inner_sig p.iv
-
 let render_path : Odoc_model.Paths.Path.t -> string =
   let open Odoc_model.Paths.Path in
   let rec render_resolved : Odoc_model.Paths.Path.Resolved.t -> string =
@@ -160,7 +151,7 @@ module Path = struct
         mk ~parent kind name
     | { iv = `Parameter (functor_id, arg_name); _ } as p ->
         let parent = from_identifier (functor_id :> any) in
-        let arg_num = functor_arg_pos p in
+        let arg_num = Identifier.FunctorParameter.functor_arg_pos p in
         let kind = `Parameter arg_num in
         let name = ModuleName.to_string arg_name in
         mk ~parent kind name
@@ -380,6 +371,9 @@ module Anchor = struct
     | { iv = `SourceLocation (parent, loc); _ } ->
         let page = Path.from_identifier (parent :> Path.any) in
         Ok { page; kind = `SourceAnchor; anchor = DefName.to_string loc }
+    | { iv = `SourceLocationInternal (parent, loc); _ } ->
+        let page = Path.from_identifier (parent :> Path.any) in
+        Ok { page; kind = `SourceAnchor; anchor = LocalName.to_string loc }
     | { iv = `SourceLocationMod parent; _ } ->
         let page = Path.from_identifier (parent :> Path.any) in
         Ok { page; kind = `SourceAnchor; anchor = "" }

src/loader/cmi.ml

@@ -14,11 +14,9 @@
  * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  *)
 
-module Loader_Uid = Uid
 open Asttypes
 open Types
 module OCamlPath = Path
-module Uid = Loader_Uid
 
 open Odoc_model.Paths
 open Odoc_model.Lang
@@ -629,8 +627,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 = Identifier.Mk.constructor (parent, Odoc_model.Names.ConstructorName.make_std name) in
+  let id = Ident_env.find_constructor_identifier env cd.cd_id in
   let container = (parent : Identifier.DataType.t :> Identifier.LabelParent.t) in
   let doc = Doc_attr.attached_no_tag container cd.cd_attributes in
   let args =
@@ -742,8 +739,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 = Identifier.Mk.extension(parent, Odoc_model.Names.ExtensionName.make_std name) in
+  let id = Env.find_extension_identifier env id in
   let locs = None in
   let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) in
   let doc = Doc_attr.attached_no_tag container ext.ext_attributes in
@@ -776,8 +772,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 = Identifier.Mk.exception_(parent, Odoc_model.Names.ExceptionName.make_std name) in
+  let id = Env.find_exception_identifier env id in
   let locs = None in
   let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) in
   let doc = Doc_attr.attached_no_tag container ext.ext_attributes in
@@ -933,12 +928,12 @@ let rec read_module_type env parent (mty : Odoc_model.Compat.module_type) =
           match parameter with
           | Unit -> Odoc_model.Lang.FunctorParameter.Unit, env
           | Named (id_opt, arg) ->
-              let name, env = match id_opt with
-                | Some id -> Ident.name id,  Env.add_parameter parent id (ModuleName.of_ident id) env
-                | None -> "_", env
+              let id, env = match id_opt with
+                | None -> Identifier.Mk.parameter(parent, Odoc_model.Names.ModuleName.make_std "_"), env
+                | Some id -> let env = Env.add_parameter parent id (ModuleName.of_ident id) env in
+                  Ident_env.find_parameter_identifier env id, env
               in
-              let id = Identifier.Mk.parameter(parent, Odoc_model.Names.ModuleName.make_std name) in
-              let arg = read_module_type env id arg in
+              let arg = read_module_type env (id :> Identifier.Signature.t) arg in
               Odoc_model.Lang.FunctorParameter.Named ({ FunctorParameter. id; expr = arg }), env
         in
         let res = read_module_type env (Identifier.Mk.result parent) res in
@@ -1082,5 +1077,5 @@ and read_signature env parent (items : Odoc_model.Compat.signature) =
 
 let read_interface root name intf =
   let id = Identifier.Mk.root (root, Odoc_model.Names.ModuleName.make_std name) in
-  let items = read_signature Env.empty id intf in
+  let items = read_signature (Env.empty ()) id intf in
   (id, items)

src/loader/cmt.ml

@@ -367,31 +367,30 @@ let rec read_module_expr env parent label_parent mexpr =
           match parameter with
           | Unit -> FunctorParameter.Unit, env
           | Named (id_opt, _, arg) ->
-              let name, env =
+              let id, env =
                 match id_opt with
-                | Some id -> Ident.name id, Env.add_parameter parent id (ModuleName.of_ident id) env
-                | None -> "_", env
+                | None -> Identifier.Mk.parameter (parent, Odoc_model.Names.ModuleName.make_std "_"), env
+                | Some id -> let env = Env.add_parameter parent id (ModuleName.of_ident id) env in
+                  Env.find_parameter_identifier env id, env
               in
-              let id = Identifier.Mk.parameter (parent, Odoc_model.Names.ModuleName.make_std name) in
-              let arg = Cmti.read_module_type env id label_parent arg in
+              let arg = Cmti.read_module_type env (id :> Identifier.Signature.t) label_parent arg in
 
               Named { id; expr=arg }, env
           in
         let res = read_module_expr env (Identifier.Mk.result parent) label_parent res in
         Functor (f_parameter, res)
 #else
     | Tmod_functor(id, _, arg, res) ->
+        let new_env = Env.add_parameter parent id (ModuleName.of_ident id) env in
         let f_parameter =
           match arg with
           | None -> FunctorParameter.Unit
           | Some arg ->
-              let name = Ident.name id in
-              let id = Identifier.Mk.parameter (parent, ModuleName.make_std name) in
-          let arg = Cmti.read_module_type env id label_parent arg in
-          Named { FunctorParameter. id; expr = arg; }
+              let id = Env.find_parameter_identifier new_env id in
+              let arg = Cmti.read_module_type env (id :> Identifier.Signature.t) label_parent arg in
+              Named { FunctorParameter. id; expr = arg; }
         in
-        let env = Env.add_parameter parent id (ModuleName.of_ident id) env in
-        let res = read_module_expr env (Identifier.Mk.result parent) label_parent res in
+        let res = read_module_expr new_env (Identifier.Mk.result parent) label_parent res in
         Functor(f_parameter, res)
 #endif
     | Tmod_apply _ ->
@@ -603,7 +602,7 @@ and read_structure :
 let read_implementation root name impl =
   let id = Identifier.Mk.root (root, Odoc_model.Names.ModuleName.make_std name) in
   let sg, canonical =
-    read_structure Odoc_model.Semantics.Expect_canonical Env.empty id impl
+    read_structure Odoc_model.Semantics.Expect_canonical (Env.empty ()) id impl
   in
   (id, sg, (canonical :> Odoc_model.Paths.Path.Module.t option))
 

src/loader/cmti.ml

@@ -213,9 +213,7 @@ let read_constructor_declaration_arguments env parent label_parent arg =
 
 let read_constructor_declaration env parent cd =
   let open TypeDecl.Constructor in
-  let open Odoc_model.Names in
-  let name = Ident.name cd.cd_id in
-  let id = Identifier.Mk.constructor(parent, ConstructorName.make_std name) in
+  let id = Ident_env.find_constructor_identifier env cd.cd_id in
   let container = (parent : Identifier.DataType.t :> Identifier.Parent.t) in
   let label_container = (container :> Identifier.LabelParent.t) in
   let doc = Doc_attr.attached_no_tag label_container cd.cd_attributes in
@@ -292,9 +290,7 @@ let read_type_substitutions env parent decls =
 
 let read_extension_constructor env parent ext =
   let open Extension.Constructor in
-  let open Odoc_model.Names in
-  let name = Ident.name ext.ext_id in
-  let id = Identifier.Mk.extension(parent, ExtensionName.make_std name) in
+  let id = Env.find_extension_identifier env ext.ext_id in
   let locs = None in
   let container = (parent : Identifier.Signature.t :> Identifier.Parent.t) in
   let label_container = (container :> Identifier.LabelParent.t) in
@@ -327,9 +323,7 @@ let read_type_extension env parent tyext =
 
 let read_exception env parent (ext : extension_constructor) =
   let open Exception in
-  let open Odoc_model.Names in
-  let name = Ident.name ext.ext_id in
-  let id = Identifier.Mk.exception_(parent, ExceptionName.make_std name) in
+  let id = Env.find_exception_identifier env ext.ext_id in
   let locs = None in
   let container = (parent : Identifier.Signature.t :> Identifier.Parent.t) in
   let label_container = (container :> Identifier.LabelParent.t) in
@@ -523,31 +517,30 @@ and read_module_type env parent label_parent mty =
           match parameter with
           | Unit -> FunctorParameter.Unit, env
           | Named (id_opt, _, arg) ->
-            let name, env =
+            let id, env =
               match id_opt with
+              | None -> Identifier.Mk.parameter (parent, ModuleName.make_std "_"), env
               | Some id ->
-                 Ident.name id, Env.add_parameter parent id (ModuleName.of_ident id) env
-              | None -> "_", env
+                 let env = Env.add_parameter parent id (ModuleName.of_ident id) env in
+                 Env.find_parameter_identifier env id, env
             in
-            let id = Identifier.Mk.parameter (parent, ModuleName.make_std name) in
-            let arg = read_module_type env id label_parent arg in
+            let arg = read_module_type env (id :> Identifier.Signature.t) label_parent arg in
             Named { id; expr = arg; }, env
         in
         let res = read_module_type env (Identifier.Mk.result parent) label_parent res in
         Functor (f_parameter, res)
 #else
     | Tmty_functor(id, _, arg, res) ->
+        let new_env = Env.add_parameter parent id (ModuleName.of_ident id) env in
         let f_parameter =
           match arg with
           | None -> Odoc_model.Lang.FunctorParameter.Unit
           | Some arg ->
-              let name = Ident.name id in
-              let id = Identifier.Mk.parameter (parent, Odoc_model.Names.ModuleName.make_std name) in
-              let arg = read_module_type env id label_parent arg in
+              let id = Ident_env.find_parameter_identifier new_env id in
+              let arg = read_module_type env (id :> Identifier.Signature.t) label_parent arg in
               Named { FunctorParameter. id; expr = arg }
         in
-        let env = Env.add_parameter parent id (ModuleName.of_ident id) env in
-        let res = read_module_type env (Identifier.Mk.result parent) label_parent res in
+        let res = read_module_type new_env (Identifier.Mk.result parent) label_parent res in
         Functor( f_parameter, res)
 #endif
     | Tmty_with(body, subs) -> (
@@ -805,6 +798,6 @@ and read_signature :
 let read_interface root name intf =
   let id = Identifier.Mk.root (root, Odoc_model.Names.ModuleName.make_std name) in
   let sg, canonical =
-    read_signature Odoc_model.Semantics.Expect_canonical Env.empty id intf
+    read_signature Odoc_model.Semantics.Expect_canonical (Env.empty ()) id intf
   in
   (id, sg, (canonical :> Odoc_model.Paths.Path.Module.t option))

src/loader/dune

@@ -22,4 +22,4 @@
  (preprocess
   (action
    (run %{bin:cppo} -V OCAML:%{ocaml_version} %{input-file})))
- (libraries odoc_model odoc-parser syntax_highlighter))
+ (libraries odoc_model odoc-parser syntax_highlighter odoc_document))