Try to resolve references in stage 0

CHANGES.md

@@ -2,6 +2,9 @@
 
 ### Added
 
+- Addded `--suppress-warnings` to the CLI to remove warnings from a unit, even
+  if they end up being raised in another unit through expansion (@jonludlam,
+  #1260)
 - Improve jump to implementation in rendered source code, and add a
   `count-occurrences` flag and command to count occurrences of every identifiers
   (@panglesd, #976)

doc/examples/resolution.mli

@@ -86,7 +86,6 @@ module Hidden : sig
 
   type v = T of t
 
-  type w = U of u
 end
 
 module References : sig

doc/odoc.mld

@@ -58,6 +58,4 @@ The main other pages of this site:
 - {!page-ocamldoc_differences} outlines differences from OCamldoc.
 - {!page-dune} shows how to create docs using Dune.
 - {!page-parent_child_spec} delineates parent/child specifications.
-- {!page-interface} describes [odoc]'s public-facing interface and their support guarantees.
-- {!page-ocamlary} demonstrates the rendering of most of the OCaml constructs.
-- {!page-api_reference} lists [odoc]'s API reference library.
+- {!page-interface} describes [odoc]'s public-facing interface and their support guarantees.

dune

@@ -23,3 +23,8 @@
   (progn
    (bash "diff doc/driver.mld doc/driver.mld.corrected >&2 || true")
    (cat doc/driver-benchmarks.json))))
+
+(install
+ (files odoc-config.sexp)
+ (section doc)
+ (package odoc))

odoc-config.sexp

@@ -0,0 +1,2 @@
+(libraries fmt)
+

src/document/comment.ml

@@ -415,6 +415,6 @@ let standalone docs =
 
 let to_ir (docs : Comment.docs) =
   Utils.flatmap ~f:block_element
-  @@ List.map (fun x -> x.Odoc_model.Location_.value) docs
+  @@ List.map (fun x -> x.Odoc_model.Location_.value) docs.elements
 
 let has_doc docs = docs <> []

src/document/generator.ml

@@ -531,7 +531,9 @@ module Make (Syntax : SYNTAX) = struct
                in
                let anchor = Some url in
                let rhs = Comment.to_ir fld.doc in
-               let doc = if not (Comment.has_doc fld.doc) then [] else rhs in
+               let doc =
+                 if not (Comment.has_doc fld.doc.elements) then [] else rhs
+               in
                let markers = Syntax.Comment.markers in
                DocumentedSrc.Documented { anchor; attrs; code; doc; markers })
       in
@@ -610,7 +612,7 @@ module Make (Syntax : SYNTAX) = struct
                    let anchor = Some url in
                    let rhs = Comment.to_ir cstr.doc in
                    let doc =
-                     if not (Comment.has_doc cstr.doc) then [] else rhs
+                     if not (Comment.has_doc cstr.doc.elements) then [] else rhs
                    in
                    let markers = Syntax.Comment.markers in
                    DocumentedSrc.Nested { anchor; attrs; code; doc; markers })
@@ -706,7 +708,9 @@ module Make (Syntax : SYNTAX) = struct
                       ++
                       if Syntax.Type.Variant.parenthesize_params then params
                       else O.txt " " ++ O.keyword "of" ++ O.sp ++ params)),
-                match doc with [] -> None | _ -> Some (Comment.to_ir doc) ))
+                match doc with
+                | { elements = []; _ } -> None
+                | _ -> Some (Comment.to_ir doc) ))
         in
         let markers = Syntax.Comment.markers in
         try
@@ -920,11 +924,11 @@ module Make (Syntax : SYNTAX) = struct
   module Sectioning : sig
     open Odoc_model
 
-    val comment_items : Comment.docs -> Item.t list
+    val comment_items : Comment.elements -> Item.t list
 
-    val docs : Comment.docs -> Item.t list * Item.t list
+    val docs : Comment.elements -> Item.t list * Item.t list
   end = struct
-    let take_until_heading_or_end (docs : Odoc_model.Comment.docs) =
+    let take_until_heading_or_end (docs : Odoc_model.Comment.elements) =
       let content, _, rest =
         Doctree.Take.until docs ~classify:(fun b ->
             match b.Location.value with
@@ -935,7 +939,7 @@ module Make (Syntax : SYNTAX) = struct
       in
       (content, rest)
 
-    let comment_items (input0 : Odoc_model.Comment.docs) =
+    let comment_items (input0 : Odoc_model.Comment.elements) =
       let rec loop input_comment acc =
         match input_comment with
         | [] -> List.rev acc
@@ -1070,11 +1074,11 @@ module Make (Syntax : SYNTAX) = struct
                 in
                 loop rest acc_items
             | Comment (`Docs c) ->
-                let items = Sectioning.comment_items c in
+                let items = Sectioning.comment_items c.elements in
                 loop rest (List.rev_append items acc_items))
       in
       (* FIXME: use [t.self] *)
-      (c.doc, loop c.items [])
+      (c.doc.elements, loop c.items [])
 
     let rec class_decl (cd : Odoc_model.Lang.Class.decl) =
       match cd with
@@ -1111,7 +1115,8 @@ module Make (Syntax : SYNTAX) = struct
             let expansion_doc, items = class_signature csig in
             let url = Url.Path.from_identifier t.id in
             let page =
-              make_expansion_page ~source_anchor url [ t.doc; expansion_doc ]
+              make_expansion_page ~source_anchor url
+                [ t.doc.elements; expansion_doc ]
                 items
             in
             ( O.documentedSrc @@ path url [ inline @@ Text name ],
@@ -1132,7 +1137,7 @@ module Make (Syntax : SYNTAX) = struct
       in
       let attr = [ "class" ] in
       let anchor = path_to_id t.id in
-      let doc = Comment.synopsis ~decl_doc:t.doc ~expansion_doc in
+      let doc = Comment.synopsis ~decl_doc:t.doc.elements ~expansion_doc in
       Item.Declaration { attr; anchor; doc; content; source_anchor }
 
     let class_type (t : Odoc_model.Lang.ClassType.t) =
@@ -1149,7 +1154,8 @@ module Make (Syntax : SYNTAX) = struct
             let url = Url.Path.from_identifier t.id in
             let expansion_doc, items = class_signature csig in
             let page =
-              make_expansion_page ~source_anchor url [ t.doc; expansion_doc ]
+              make_expansion_page ~source_anchor url
+                [ t.doc.elements; expansion_doc ]
                 items
             in
             ( O.documentedSrc @@ path url [ inline @@ Text name ],
@@ -1166,14 +1172,14 @@ module Make (Syntax : SYNTAX) = struct
       in
       let attr = [ "class-type" ] in
       let anchor = path_to_id t.id in
-      let doc = Comment.synopsis ~decl_doc:t.doc ~expansion_doc in
+      let doc = Comment.synopsis ~decl_doc:t.doc.elements ~expansion_doc in
       Item.Declaration { attr; anchor; doc; content; source_anchor }
   end
 
   open Class
 
   module Module : sig
-    val signature : Lang.Signature.t -> Comment.Comment.docs * Item.t list
+    val signature : Lang.Signature.t -> Comment.Comment.elements * Item.t list
     (** Returns [header_doc, content]. *)
   end = struct
     let internal_module m =
@@ -1242,7 +1248,7 @@ module Make (Syntax : SYNTAX) = struct
             | Exception e -> continue @@ exn e
             | Value v -> continue @@ value v
             | Open o ->
-                let items = Sectioning.comment_items o.doc in
+                let items = Sectioning.comment_items o.doc.elements in
                 loop rest (List.rev_append items acc_items)
             | Comment `Stop ->
                 let rest =
@@ -1252,10 +1258,10 @@ module Make (Syntax : SYNTAX) = struct
                 in
                 loop rest acc_items
             | Comment (`Docs c) ->
-                let items = Sectioning.comment_items c in
+                let items = Sectioning.comment_items c.elements in
                 loop rest (List.rev_append items acc_items))
       in
-      (Lang.extract_signature_doc s, loop s.items [])
+      ((Lang.extract_signature_doc s).elements, loop s.items [])
 
     and functor_parameter :
         Odoc_model.Lang.FunctorParameter.parameter -> DocumentedSrc.t =
@@ -1319,8 +1325,8 @@ module Make (Syntax : SYNTAX) = struct
       let source_anchor = None in
       let modname = Paths.Identifier.name t.id in
       let modname, expansion_doc, mty =
-        module_type_manifest ~subst:true ~source_anchor modname t.id t.doc
-          (Some t.manifest) prefix
+        module_type_manifest ~subst:true ~source_anchor modname t.id
+          t.doc.elements (Some t.manifest) prefix
       in
       let content =
         O.documentedSrc (prefix ++ modname)
@@ -1330,12 +1336,12 @@ module Make (Syntax : SYNTAX) = struct
       in
       let attr = [ "module-type" ] in
       let anchor = path_to_id t.id in
-      let doc = Comment.synopsis ~decl_doc:t.doc ~expansion_doc in
+      let doc = Comment.synopsis ~decl_doc:t.doc.elements ~expansion_doc in
       Item.Declaration { attr; anchor; doc; content; source_anchor }
 
     and simple_expansion :
         Odoc_model.Lang.ModuleType.simple_expansion ->
-        Comment.Comment.docs * Item.t list =
+        Comment.Comment.elements * Item.t list =
      fun t ->
       let rec extract_functor_params
           (f : Odoc_model.Lang.ModuleType.simple_expansion) =
@@ -1373,7 +1379,7 @@ module Make (Syntax : SYNTAX) = struct
 
     and expansion_of_module_type_expr :
         Odoc_model.Lang.ModuleType.expr ->
-        (Comment.Comment.docs * Item.t list) option =
+        (Comment.Comment.elements * Item.t list) option =
      fun t ->
       let rec simple_expansion_of (t : Odoc_model.Lang.ModuleType.expr) =
         match t with
@@ -1417,7 +1423,8 @@ module Make (Syntax : SYNTAX) = struct
             let url = Url.Path.from_identifier t.id in
             let link = path url [ inline @@ Text modname ] in
             let page =
-              make_expansion_page ~source_anchor url [ t.doc; expansion_doc ]
+              make_expansion_page ~source_anchor url
+                [ t.doc.elements; expansion_doc ]
                 items
             in
             (link, status, Some page, Some expansion_doc)
@@ -1436,7 +1443,7 @@ module Make (Syntax : SYNTAX) = struct
       in
       let attr = [ "module" ] in
       let anchor = path_to_id t.id in
-      let doc = Comment.synopsis ~decl_doc:t.doc ~expansion_doc in
+      let doc = Comment.synopsis ~decl_doc:t.doc.elements ~expansion_doc in
       Item.Declaration { attr; anchor; doc; content; source_anchor }
 
     and simple_expansion_in_decl (base : Paths.Identifier.Module.t) se =
@@ -1501,8 +1508,8 @@ module Make (Syntax : SYNTAX) = struct
       let modname = Paths.Identifier.name t.id in
       let source_anchor = source_anchor t.source_loc in
       let modname, expansion_doc, mty =
-        module_type_manifest ~subst:false ~source_anchor modname t.id t.doc
-          t.expr prefix
+        module_type_manifest ~subst:false ~source_anchor modname t.id
+          t.doc.elements t.expr prefix
       in
       let content =
         O.documentedSrc (prefix ++ modname)
@@ -1512,7 +1519,7 @@ module Make (Syntax : SYNTAX) = struct
       in
       let attr = [ "module-type" ] in
       let anchor = path_to_id t.id in
-      let doc = Comment.synopsis ~decl_doc:t.doc ~expansion_doc in
+      let doc = Comment.synopsis ~decl_doc:t.doc.elements ~expansion_doc in
       Item.Declaration { attr; anchor; doc; content; source_anchor }
 
     and umty_hidden : Odoc_model.Lang.ModuleType.U.expr -> bool = function
@@ -1772,7 +1779,7 @@ module Make (Syntax : SYNTAX) = struct
         in*)
       (*let title = Odoc_model.Names.PageName.to_string name in*)
       let url = Url.Path.from_identifier t.name in
-      let preamble, items = Sectioning.docs t.content in
+      let preamble, items = Sectioning.docs t.content.elements in
       let source_anchor = None in
       Document.Page { Page.preamble; items; url; source_anchor }
 

src/document/sidebar.ml

@@ -94,7 +94,7 @@ end = struct
             | Page { short_title = None; _ } ->
                 let title =
                   let open Odoc_model in
-                  match Comment.find_zero_heading entry.doc with
+                  match Comment.find_zero_heading entry.doc.elements with
                   | Some t -> t
                   | None ->
                       let name =

src/driver/compile.ml

@@ -143,6 +143,7 @@ let compile ?partial ~partial_dir (all : Odoc_unit.t list) =
                  in
                  Odoc.compile ~output_dir:unit.output_dir
                    ~input_file:unit.input_file ~includes
+                   ~suppress_warnings:(not unit.enable_warnings)
                    ~parent_id:unit.parent_id;
                  Atomic.incr Stats.stats.compiled_units;
 
@@ -191,7 +192,7 @@ let compile ?partial ~partial_dir (all : Odoc_unit.t list) =
     | `Mld ->
         let includes = Fpath.Set.empty in
         Odoc.compile ~output_dir:unit.output_dir ~input_file:unit.input_file
-          ~includes ~parent_id:unit.parent_id;
+          ~includes ~suppress_warnings:false ~parent_id:unit.parent_id;
         Atomic.incr Stats.stats.compiled_mlds;
         Ok [ unit ]
     | `Md ->

src/driver/landing_pages.ml

@@ -18,13 +18,14 @@ let make_index ~dirs ?pkg ~rel_dir ?index ~content () =
   let odoc_file = Fpath.(odoc_dir // rel_dir / "page-index.odoc") in
   let odocl_file = Fpath.(odocl_dir // rel_dir / "page-index.odocl") in
   let parent_id = rel_dir |> Odoc.Id.of_fpath in
+  let pkg_args = Pkg_args.v ~pages ~libs ~odoc_dir ~odocl_dir in
   Util.with_out_to input_file (fun oc ->
       fpf (Format.formatter_of_out_channel oc) "%t@?" content)
   |> Result.get_ok;
   {
     output_dir = dirs.odoc_dir;
     pkgname = None;
-    pkg_args = { Pkg_args.pages; libs; odoc_dir; odocl_dir };
+    pkg_args;
     parent_id;
     input_file;
     odoc_file;

src/driver/odoc.ml

@@ -36,7 +36,7 @@ let compile_deps f =
   | [ (_, digest) ], deps -> Ok { digest; deps }
   | _ -> Error (`Msg "odd")
 
-let compile ~output_dir ~input_file:file ~includes ~parent_id =
+let compile ~output_dir ~input_file:file ~includes ~suppress_warnings ~parent_id =
   let open Cmd in
   let includes =
     Fpath.Set.fold
@@ -52,6 +52,7 @@ let compile ~output_dir ~input_file:file ~includes ~parent_id =
     %% includes % "--enable-missing-root-warning"
   in
   let cmd = cmd % "--parent-id" % Id.to_string parent_id in
+  let cmd = if suppress_warnings then cmd % "--suppress-warnings" else cmd in
   let desc = Printf.sprintf "Compiling %s" (Fpath.to_string file) in
   ignore
   @@ Cmd_outputs.submit

src/driver/odoc.mli

@@ -24,6 +24,7 @@ val compile :
   output_dir:Fpath.t ->
   input_file:Fpath.t ->
   includes:Fpath.set ->
+  suppress_warnings:bool ->
   parent_id:Id.t ->
   unit
 val compile_md :

src/driver/odoc_unit.ml

@@ -2,11 +2,15 @@ module Pkg_args = struct
   type t = {
     odoc_dir : Fpath.t;
     odocl_dir : Fpath.t;
-    pages : (string * Fpath.t) list;
-    libs : (string * Fpath.t) list;
+    pages : Fpath.t Util.StringMap.t;
+    libs : Fpath.t Util.StringMap.t;
   }
 
-  let map_rel dir = List.map (fun (a, b) -> (a, Fpath.(dir // b)))
+  let v ~odoc_dir ~odocl_dir ~pages ~libs =
+    let pages, libs = Util.StringMap.(of_list pages, of_list libs) in
+    { odoc_dir; odocl_dir; pages; libs }
+
+  let map_rel dir m = Util.StringMap.fold (fun a b acc -> (a, Fpath.(dir // b)) :: acc) m []
 
   let compiled_pages v = map_rel v.odoc_dir v.pages
   let compiled_libs v = map_rel v.odoc_dir v.libs
@@ -21,8 +25,8 @@ module Pkg_args = struct
     {
       odoc_dir = v1.odoc_dir;
       odocl_dir = v1.odocl_dir;
-      pages = v1.pages @ v2.pages;
-      libs = v1.libs @ v2.libs;
+      pages = Util.StringMap.union (fun _ x _ -> Some x) v1.pages v2.pages;
+      libs = Util.StringMap.union (fun _ x _ -> Some x) v1.libs v2.libs;
     }
 
   let pp fmt x =
@@ -33,7 +37,7 @@ module Pkg_args = struct
     in
     Format.fprintf fmt
       "@[<hov>odoc_dir: %a@;odocl_dir: %a@;pages: [%a]@;libs: [%a]@]" Fpath.pp
-      x.odoc_dir Fpath.pp x.odocl_dir sfp_pp x.pages sfp_pp x.libs
+      x.odoc_dir Fpath.pp x.odocl_dir sfp_pp (Util.StringMap.bindings x.pages) sfp_pp (Util.StringMap.bindings x.libs)
 end
 
 type sidebar = { output_file : Fpath.t; json : bool }

src/driver/odoc_unit.mli

@@ -1,16 +1,17 @@
 module Pkg_args : sig
-  type t = {
-    odoc_dir : Fpath.t;
-    odocl_dir : Fpath.t;
-    pages : (string * Fpath.t) list;
-    libs : (string * Fpath.t) list;
-  }
+  type t
 
   val compiled_pages : t -> (string * Fpath.t) list
   val compiled_libs : t -> (string * Fpath.t) list
   val linked_pages : t -> (string * Fpath.t) list
   val linked_libs : t -> (string * Fpath.t) list
 
+  val v : odoc_dir:Fpath.t ->
+    odocl_dir:Fpath.t ->
+    pages:(string * Fpath.t) list ->
+    libs:(string * Fpath.t) list ->
+    t
+
   val combine : t -> t -> t
 
   val pp : t Fmt.t