Warnings: allow disabling warnings coming from specific units

When docstrings go are inherited, eg from an include or a functor expansion,
warnings may be generated in one docs while the fix is in a dependency.

This commit allows to tag each docstring with a boolean to indicate whether it
comes from a unit with warnings enabled or disabled.

src/document/comment.ml

···
 
 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

···
                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
···
                    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 })
···
                       ++
                       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
···
   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
···
       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
···
                 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
···
             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 ],
···
       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) =
···
             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 ],
···
       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 =
···
             | 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 =
···
                 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 =
···
       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)
···
       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) =
···
 
     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
···
             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)
···
       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 =
···
       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)
···
       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
···
         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

···
             | 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/index/skeleton.ml

···
 module Entry = struct
   let of_comp_unit (u : Compilation_unit.t) =
     let has_expansion = true in
-    let doc = match u.content with Pack _ -> [] | Module m -> m.doc in
+    let doc =
+      match u.content with
+      | Pack _ ->
+          { Odoc_model.Comment.elements = []; suppress_warnings = false }
+      | Module m -> m.doc
+    in
     Entry.entry ~id:u.id ~doc ~kind:(Module { has_expansion })
 
   let of_module (m : Module.t) =

src/index/skeleton_of.ml

···
   try_ Astring.String.compare by_name @@ fun () -> 0
 
 let rec t_of_in_progress (dir : In_progress.in_progress) : t =
+  let empty_doc = { Comment.elements = []; suppress_warnings = false } in
+
   let entry_of_page page =
     let kind = Entry.Page page.Lang.Page.frontmatter in
     let doc = page.content in
···
   in
   let entry_of_impl id =
     let kind = Entry.Impl in
-    let doc = [] in
+    let doc = empty_doc in
     Entry.entry ~kind ~doc ~id
   in
   let children_order, index =
···
           match In_progress.root_dir dir with
           | Some id ->
               let kind = Entry.Dir in
-              let doc = [] in
+              let doc = empty_doc in
               Entry.entry ~kind ~doc ~id
           | None ->
               let id =
···
                 Id.Mk.leaf_page (None, Names.PageName.make_std "index")
               in
               let kind = Entry.Dir in
-              let doc = [] in
+              let doc = empty_doc in
               Entry.entry ~kind ~doc ~id
         in
         (None, entry)

src/loader/cmi.ml

···
 module Env = Ident_env
 module Paths = Odoc_model.Paths
 
+
+type env = {
+  ident_env : Env.t;
+  suppress_warnings : bool;  (** suppress warnings *)
+}
+
+let empty_doc = { Odoc_model.Comment.elements = []; suppress_warnings = false }
+
 module Compat = struct
 #if OCAML_VERSION >= (4, 14, 0)
 #if OCAML_VERSION >= (5, 3, 0)
···
           let typs = List.map (read_type_expr env) typs in
             Tuple typs
       | Tconstr(p, params, _) ->
-          let p = Env.Path.read_type env p in
+          let p = Env.Path.read_type env.ident_env p in
           let params = List.map (read_type_expr env) params in
             Constr(p, params)
       | Tvariant row -> read_row env px row
···
         let eqs = List.combine frags tyl in
 #endif
           let open TypeExpr.Package in
-          let path = Env.Path.read_module_type env p in
+          let path = Env.Path.read_module_type env.ident_env p in
           let substitutions =
             List.map
               (fun (frag,typ) ->
···
   let all_present = List.length present = List.length sorted_fields in
   match Compat.get_row_name row with
   | Some(p, params) when namable_row row ->
-      let p = Env.Path.read_type env p in
+      let p = Env.Path.read_type env.ident_env p in
       let params = List.map (read_type_expr env) params in
       if Compat.row_closed row && all_present then
         Constr (p, params)
···
       let elements =
         List.map
           (fun (name, f) ->
+            let doc = empty_doc in
             match Compat.row_field_repr f with
               | Rpresent None ->
-                Constructor {name; constant = true; arguments = []; doc = []}
+                Constructor {name; constant = true; arguments = []; doc}
               | Rpresent (Some typ) ->
                 Constructor {
                   name;
                   constant = false;
                   arguments = [read_type_expr env typ];
-                  doc = [];
+                  doc;
                 }
 #if OCAML_VERSION >= (4, 14, 0)
               | Reither(constant, typs, _) ->
···
                 let arguments =
                   List.map (read_type_expr env) typs
                 in
-                Constructor {name; constant; arguments; doc = []}
+                Constructor {name; constant; arguments; doc}
               | Rabsent -> assert false)
           sorted_fields
       in
···
         in
         Object {fields = methods; open_}
     | Some (p, _ :: params) ->
-        let p = Env.Path.read_class_type env p in
+        let p = Env.Path.read_class_type env.ident_env p in
         let params = List.map (read_type_expr env) params in
         Class (p, params)
     | _ -> assert false
   end
 
-let read_value_description env parent id vd =
+let read_value_description ({ident_env ; suppress_warnings} as env) parent id vd =
   let open Signature in
-  let id = Env.find_value_identifier env id in
+  let id = Env.find_value_identifier ident_env id in
   let source_loc = None in
   let container =
     (parent : Identifier.Signature.t :> Identifier.LabelParent.t)
   in
-  let doc = Doc_attr.attached_no_tag container vd.val_attributes in
+  let doc = Doc_attr.attached_no_tag ~suppress_warnings container vd.val_attributes in
   mark_value_description vd;
   let type_ = read_type_expr env vd.val_type in
   let value =
···
   let name = Ident.name ld.ld_id in
   let id = Identifier.Mk.field (parent, Odoc_model.Names.FieldName.make_std name) in
   let doc =
-    Doc_attr.attached_no_tag
+    Doc_attr.attached_no_tag ~suppress_warnings:env.suppress_warnings
       (parent :> Identifier.LabelParent.t) ld.ld_attributes
   in
   let mutable_ = (ld.ld_mutable = Mutable) in
···
 
 let read_constructor_declaration env parent cd =
   let open TypeDecl.Constructor in
-  let id = Ident_env.find_constructor_identifier env cd.cd_id in
+  let id = Ident_env.find_constructor_identifier env.ident_env cd.cd_id in
   let container = (parent :> Identifier.LabelParent.t) in
-  let doc = Doc_attr.attached_no_tag container cd.cd_attributes in
+  let doc = Doc_attr.attached_no_tag ~suppress_warnings:env.suppress_warnings container cd.cd_attributes in
   let args =
     read_constructor_declaration_arguments env
       (parent :> Identifier.FieldParent.t) cd.cd_args
···
   let open ClassSignature in
   read_type_constraints env params
   |> List.map (fun (left, right) ->
-         Constraint { Constraint.left; right; doc = [] })
+         Constraint { Constraint.left; right; doc = empty_doc })
 
 let read_type_declaration env parent id decl =
   let open TypeDecl in
-  let id = Env.find_type_identifier env id in
+  let id = Env.find_type_identifier env.ident_env id in
   let source_loc = None in
   let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) in
   let doc, canonical =
-    Doc_attr.attached Odoc_model.Semantics.Expect_canonical container decl.type_attributes
+    Doc_attr.attached ~suppress_warnings:env.suppress_warnings Odoc_model.Semantics.Expect_canonical container decl.type_attributes
   in
   let canonical = match canonical with | None -> None | Some s -> Doc_attr.conv_canonical_type s in
   let params = mark_type_declaration decl in
···
 
 let read_extension_constructor env parent id ext =
   let open Extension.Constructor in
-  let id = Env.find_extension_identifier env id in
+  let id = Env.find_extension_identifier env.ident_env id in
   let source_loc = None in
   let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) in
-  let doc = Doc_attr.attached_no_tag container ext.ext_attributes in
+  let doc = Doc_attr.attached_no_tag ~suppress_warnings:env.suppress_warnings container ext.ext_attributes in
   let args =
     read_constructor_declaration_arguments env
       (parent : Identifier.Signature.t :> Identifier.FieldParent.t) ext.ext_args
···
 
 let read_type_extension env parent id ext rest =
   let open Extension in
-  let type_path = Env.Path.read_type env ext.ext_type_path in
+  let type_path = Env.Path.read_type env.ident_env ext.ext_type_path in
   let doc = Doc_attr.empty in
   let type_params = mark_type_extension' ext rest in
   let first = read_extension_constructor env parent id ext in
···
 
 let read_exception env parent id ext =
   let open Exception in
-  let id = Env.find_exception_identifier env id in
+  let id = Env.find_exception_identifier env.ident_env id in
   let source_loc = None in
   let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) in
-  let doc = Doc_attr.attached_no_tag container ext.ext_attributes in
+  let doc = Doc_attr.attached_no_tag ~suppress_warnings:env.suppress_warnings container ext.ext_attributes in
     mark_exception ext;
     let args =
       read_constructor_declaration_arguments env
···
       || List.exists aliasable params
       then read_class_signature env parent params cty
       else begin
-        let p = Env.Path.read_class_type env p in
+        let p = Env.Path.read_class_type env.ident_env p in
         let params = List.map (read_type_expr env) params in
           Constr(p, params)
       end
···
         List.map (read_method env parent (Compat.csig_concr csig)) methods
       in
       let items = constraints @ instance_variables @ methods in
-      Signature {self; items; doc = []}
+      Signature {self; items; doc = empty_doc}
   | Cty_arrow _ -> assert false
 
 let rec read_virtual = function
···
 
 let read_class_type_declaration env parent id cltd =
   let open ClassType in
-  let id = Env.find_class_type_identifier env id in
+  let id = Env.find_class_type_identifier env.ident_env id in
   let source_loc = None in
   let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) in
-  let doc = Doc_attr.attached_no_tag container cltd.clty_attributes in
+  let doc = Doc_attr.attached_no_tag ~suppress_warnings:env.suppress_warnings container cltd.clty_attributes in
     mark_class_type_declaration cltd;
     let params =
       List.map2
···
 
 let read_class_declaration env parent id cld =
   let open Class in
-  let id = Env.find_class_identifier env id in
+  let id = Env.find_class_identifier env.ident_env id in
   let source_loc = None in
   let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) in
-  let doc = Doc_attr.attached_no_tag container cld.cty_attributes in
+  let doc = Doc_attr.attached_no_tag ~suppress_warnings:env.suppress_warnings container cld.cty_attributes in
     mark_class_declaration cld;
     let params =
       List.map2
···
 let rec read_module_type env parent (mty : Odoc_model.Compat.module_type) =
   let open ModuleType in
     match mty with
-    | Mty_ident p -> Path {p_path = Env.Path.read_module_type env p; p_expansion=None }
+    | Mty_ident p -> Path {p_path = Env.Path.read_module_type env.ident_env p; p_expansion=None }
     | Mty_signature sg -> Signature (read_signature env parent sg)
     | Mty_functor(parameter, res) ->
         let f_parameter, env =
···
           | Named (id_opt, arg) ->
               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
+                | Some id -> let e' = Env.add_parameter parent id (ModuleName.of_ident id) env.ident_env in
+                  Ident_env.find_parameter_identifier e' id, {env with ident_env = e'}
               in
               let arg = read_module_type env (id :> Identifier.Signature.t) arg in
               Odoc_model.Lang.FunctorParameter.Named ({ FunctorParameter. id; expr = arg }), env
···
         let res = read_module_type env (Identifier.Mk.result parent) res in
         Functor( f_parameter, res)
     | Mty_alias p ->
-        let t_original_path = Env.Path.read_module env p in
+        let t_original_path = Env.Path.read_module env.ident_env p in
         let t_desc = ModPath t_original_path in
         TypeOf { t_desc; t_expansion = None; t_original_path }
 
 and read_module_type_declaration env parent id (mtd : Odoc_model.Compat.modtype_declaration) =
   let open ModuleType in
-  let id = Env.find_module_type env id in
+  let id = Env.find_module_type env.ident_env id in
   let source_loc = None in
   let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) in
-  let doc, canonical = Doc_attr.attached Odoc_model.Semantics.Expect_canonical container mtd.mtd_attributes in
+  let doc, canonical = Doc_attr.attached ~suppress_warnings:env.suppress_warnings Odoc_model.Semantics.Expect_canonical container mtd.mtd_attributes in
   let canonical = match canonical with | None -> None | Some s -> Doc_attr.conv_canonical_module_type s in
   let expr = opt_map (read_module_type env (id :> Identifier.Signature.t)) mtd.mtd_type in
   {id; source_loc; doc; canonical; expr }
 
 and read_module_declaration env parent ident (md : Odoc_model.Compat.module_declaration) =
   let open Module in
-  let id = (Env.find_module_identifier env ident :> Identifier.Module.t) in
+  let id = (Env.find_module_identifier env.ident_env ident :> Identifier.Module.t) in
   let source_loc = None in
   let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) in
-  let doc, canonical = Doc_attr.attached Odoc_model.Semantics.Expect_canonical container md.md_attributes in
+  let doc, canonical = Doc_attr.attached ~suppress_warnings:env.suppress_warnings Odoc_model.Semantics.Expect_canonical container md.md_attributes in
   let canonical = match canonical with | None -> None | Some s -> Some (Doc_attr.conv_canonical_module s) in
   let type_ =
     match md.md_type with
-    | Mty_alias p -> Alias (Env.Path.read_module env p, None)
+    | Mty_alias p -> Alias (Env.Path.read_module env.ident_env p, None)
     | _ -> ModuleType (read_module_type env (id :> Identifier.Signature.t) md.md_type)
   in
   let hidden =
···
     | Sig_value(id, v, _) :: rest ->
         let vd = read_value_description env parent id v in
         let shadowed =
-          if Env.is_shadowed env id
+          if Env.is_shadowed env.ident_env id
           then
-            let identifier = Env.find_value_identifier env id in
+            let identifier = Env.find_value_identifier env.ident_env id in
           match identifier.iv with
           | `Value (_, n) -> { shadowed with s_values = (Odoc_model.Names.parenthesise (Ident.name id), n) :: shadowed.s_values }
           else shadowed
···
     | Sig_type(id, decl, rec_status, _)::rest ->
         let decl = read_type_declaration env parent id decl in
         let shadowed =
-          if Env.is_shadowed env id
+          if Env.is_shadowed env.ident_env id
           then
-            let identifier = Env.find_type_identifier env id in
+            let identifier = Env.find_type_identifier env.ident_env id in
             let `Type (_, name) = identifier.iv in
             { shadowed with s_types = (Ident.name id, name) :: shadowed.s_types }
           else shadowed
···
     | Sig_module (id, _, md, rec_status, _)::rest ->
           let md = read_module_declaration env parent id md in
           let shadowed =
-            if Env.is_shadowed env id
+            if Env.is_shadowed env.ident_env id
             then
-              let identifier = Env.find_module_identifier env id in
+              let identifier = Env.find_module_identifier env.ident_env id in
             let name =
               match identifier.iv with
               | `Module (_, n) -> n 
···
     | Sig_modtype(id, mtd, _) :: rest ->
           let mtd = read_module_type_declaration env parent id mtd in
           let shadowed =
-            if Env.is_shadowed env id
+            if Env.is_shadowed env.ident_env id
             then
-              let identifier = Env.find_module_type env id in
+              let identifier = Env.find_module_type env.ident_env id in
             let name =
               match identifier.iv with
               | `ModuleType (_, n) -> n
···
 #endif
           let cl = read_class_declaration env parent id cl in
           let shadowed =
-            if Env.is_shadowed env id
+            if Env.is_shadowed env.ident_env id
             then
-              let identifier = Env.find_class_identifier env id in
+              let identifier = Env.find_class_identifier env.ident_env id in
             let name =
               match identifier.iv with
               | `Class (_, n) -> n
···
 #endif
         let cltyp = read_class_type_declaration env parent id cltyp in
         let shadowed =
-          if Env.is_shadowed env id
+          if Env.is_shadowed env.ident_env id
           then
-            let identifier = Env.find_class_type_identifier env id in
+            let identifier = Env.find_class_type_identifier env.ident_env id in
           let name =
             match identifier.iv with
             | `ClassType (_, n) -> n
···
     | Sig_class_type _ :: _
     | Sig_class _ :: _ -> assert false
 
-    | [] -> ({items = List.rev acc; compiled=false; removed = []; doc = [] }, shadowed)
+    | [] -> ({items = List.rev acc; compiled=false; removed = []; doc = empty_doc }, shadowed)
   in
     loop ([],{s_modules=[]; s_module_types=[]; s_values=[];s_types=[]; s_classes=[]; s_class_types=[]}) items
 
 and read_signature env parent (items : Odoc_model.Compat.signature) =
-  let env = Env.handle_signature_type_items parent items env in
+  let e' = Env.handle_signature_type_items parent items env.ident_env in
+  let env = { env with ident_env = e' } in
   fst @@ read_signature_noenv env parent items
 
 
-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 read_interface root name suppress_warnings intf =
+  let id =
+    Identifier.Mk.root (root, Odoc_model.Names.ModuleName.make_std name)
+  in
+  let items =
+    read_signature
+      { ident_env = Env.empty (); suppress_warnings }
+      id intf
+  in
   (id, items)

src/loader/cmi.mli

···
 
 module Paths = Odoc_model.Paths
 
+
+type env = {
+  ident_env : Ident_env.t; (** Environment *)
+  suppress_warnings : bool (** Suppress warnings *)
+}
+
 val read_interface :
   Odoc_model.Paths.Identifier.ContainerPage.t option ->
   string ->
+  bool ->
   Odoc_model.Compat.signature ->
   Paths.Identifier.RootModule.t * Odoc_model.Lang.Signature.t
 
···
 
 val mark_type_expr : Types.type_expr -> unit
 
-val read_type_expr : Ident_env.t ->
+val read_type_expr : env ->
                      Types.type_expr -> Odoc_model.Lang.TypeExpr.t
 
 val mark_type_extension : Types.type_expr list ->
···
 
 val read_self_type : Types.type_expr -> Odoc_model.Lang.TypeExpr.t option
 
-val read_type_constraints : Ident_env.t -> Types.type_expr list ->
+val read_type_constraints : env -> Types.type_expr list ->
                             (Odoc_model.Lang.TypeExpr.t
                              * Odoc_model.Lang.TypeExpr.t) list
 
 val read_class_constraints :
-  Ident_env.t ->
+  env ->
   Types.type_expr list ->
   Odoc_model.Lang.ClassSignature.item list
 
-val read_class_signature : Ident_env.t ->
+val read_class_signature : env ->
                            Paths.Identifier.ClassSignature.t ->
                            Types.type_expr list -> Types.class_type ->
                            Odoc_model.Lang.ClassType.expr
 
-val read_class_type : Ident_env.t ->
+val read_class_type : env ->
                       Paths.Identifier.ClassSignature.t ->
                       Types.type_expr list -> Types.class_type ->
                       Odoc_model.Lang.Class.decl
 
-val read_module_type : Ident_env.t ->
+val read_module_type : env ->
                        Paths.Identifier.Signature.t ->
                        Odoc_model.Compat.module_type -> Odoc_model.Lang.ModuleType.expr
 
-val read_signature_noenv : Ident_env.t ->
+val read_signature_noenv : env ->
                        Paths.Identifier.Signature.t ->
                        Odoc_model.Compat.signature ->
                        (Odoc_model.Lang.Signature.t * Odoc_model.Lang.Include.shadowed)
 
-val read_signature : Ident_env.t ->
+val read_signature : env ->
                      Paths.Identifier.Signature.t ->
                      Odoc_model.Compat.signature -> Odoc_model.Lang.Signature.t
 
 
-val read_extension_constructor : Ident_env.t ->
+val read_extension_constructor : env ->
                        Paths.Identifier.Signature.t ->
                        Ident.t -> Types.extension_constructor ->
                        Odoc_model.Lang.Extension.Constructor.t
 
-val read_exception : Ident_env.t ->
+val read_exception : env ->
   Paths.Identifier.Signature.t -> Ident.t ->
   Types.extension_constructor -> Odoc_model.Lang.Exception.t
+ 

src/loader/cmt.ml

···
 
 module Env = Ident_env
 
+type env = Cmi.env = {
+  ident_env : Ident_env.t;
+  suppress_warnings : bool;
+}
+
+
 let read_core_type env ctyp =
   Cmi.read_type_expr env ctyp.ctyp_type
 
···
     | Tpat_var(id,_,_uid) ->
 #endif
         let open Value in
-        let id = Env.find_value_identifier env id in
+        let id = Env.find_value_identifier env.ident_env id in
           Cmi.mark_type_expr pat.pat_type;
           let type_ = Cmi.read_type_expr env pat.pat_type in
           let value = Abstract in
···
     | Tpat_alias(pat, id, _,_) ->
 #endif
         let open Value in
-        let id = Env.find_value_identifier env id in
+        let id = Env.find_value_identifier env.ident_env id in
           Cmi.mark_type_expr pat.pat_type;
           let type_ = Cmi.read_type_expr env pat.pat_type in
           let value = Abstract in
···
 
 let read_value_binding env parent vb =
   let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) in
-  let doc = Doc_attr.attached_no_tag container vb.vb_attributes in
+  let doc = Doc_attr.attached_no_tag ~suppress_warnings:env.suppress_warnings container vb.vb_attributes in
     read_pattern env parent doc vb.vb_pat
 
 let read_value_bindings env parent vbs =
···
       (fun acc vb ->
          let open Signature in
         let comments =
-          Doc_attr.standalone_multiple container vb.vb_attributes in
+          Doc_attr.standalone_multiple container ~suppress_warnings:env.suppress_warnings vb.vb_attributes in
          let comments = List.map (fun com -> Comment com) comments in
          let vb = read_value_binding env parent vb in
           List.rev_append vb (List.rev_append comments acc))
···
 
 let read_type_extension env parent tyext =
   let open Extension in
-  let type_path = Env.Path.read_type env tyext.tyext_path in
+  let type_path = Env.Path.read_type env.ident_env tyext.tyext_path in
   let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) in
-  let doc = Doc_attr.attached_no_tag container tyext.tyext_attributes in
+  let doc = Doc_attr.attached_no_tag ~suppress_warnings:env.suppress_warnings container tyext.tyext_attributes in
   let type_params =
     List.map (fun (ctyp, _) -> ctyp.ctyp_type) tyext.tyext_params
   in
···
     rendered. For example, [constraint] items are read separately and not
     associated with their comment. *)
 let mk_class_comment = function
-  | [] -> None
+  | { Odoc_model.Comment.elements = []; _} -> None
   | doc -> Some (ClassSignature.Comment (`Docs doc))
 
 let rec read_class_type_field env parent ctf =
   let open ClassSignature in
   let open Odoc_model.Names in
   let container = (parent : Identifier.ClassSignature.t :> Identifier.LabelParent.t) in
-  let doc = Doc_attr.attached_no_tag container ctf.ctf_attributes in
+  let doc = Doc_attr.attached_no_tag ~suppress_warnings:env.suppress_warnings container ctf.ctf_attributes in
   match ctf.ctf_desc with
   | Tctf_val(name, mutable_, virtual_, typ) ->
       let open InstanceVariable in
···
       let expr = read_class_signature env parent [] cltyp in
       Some (Inherit {Inherit.expr; doc})
   | Tctf_attribute attr ->
-      match Doc_attr.standalone container attr with
+      match Doc_attr.standalone container ~suppress_warnings:env.suppress_warnings attr with
       | None -> None
       | Some doc -> Some (Comment doc)
 
···
   let open ClassType in
     match cltyp.cltyp_desc with
     | Tcty_constr(p, _, params) ->
-        let p = Env.Path.read_class_type env p in
+        let p = Env.Path.read_class_type env.ident_env p in
         let params = List.map (read_core_type env) params in
           Constr(p, params)
     | Tcty_signature csig ->
···
         let items, (doc, doc_post) = Doc_attr.extract_top_comment_class items in
         let items =
           match doc_post with
-          | [] -> items
+          | { elements = []; _ } -> items
           | _ -> Comment (`Docs doc_post) :: items
         in
         Signature {self; items; doc}
···
   let open ClassSignature in
   let open Odoc_model.Names in
   let container = (parent : Identifier.ClassSignature.t :> Identifier.LabelParent.t) in
-  let doc = Doc_attr.attached_no_tag container (cf.cf_attributes) in
+  let doc = Doc_attr.attached_no_tag ~suppress_warnings:env.suppress_warnings container (cf.cf_attributes) in
   match cf.cf_desc with
   | Tcf_val({txt = name; _}, mutable_, _, kind, _) ->
       let open InstanceVariable in
···
       Some (Inherit {Inherit.expr; doc})
   | Tcf_initializer _ -> mk_class_comment doc
   | Tcf_attribute attr ->
-      match Doc_attr.standalone container attr with
+      match Doc_attr.standalone container ~suppress_warnings:env.suppress_warnings attr with
       | None -> None
       | Some doc -> Some (Comment doc)
 
···
         let items, (doc, doc_post) = Doc_attr.extract_top_comment_class items in
         let items =
           match doc_post with
-          | [] -> items
+          | { elements = []; _ } -> items
           | _ -> Comment (`Docs doc_post) :: items
         in
         Signature {self; items; doc}
···
 
 let read_class_declaration env parent cld =
   let open Class in
-  let id = Env.find_class_identifier env cld.ci_id_class in
+  let id = Env.find_class_identifier env.ident_env cld.ci_id_class in
   let source_loc = None in
   let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) in
-  let doc = Doc_attr.attached_no_tag container cld.ci_attributes in
+  let doc = Doc_attr.attached_no_tag ~suppress_warnings:env.suppress_warnings container cld.ci_attributes in
     Cmi.mark_class_declaration cld.ci_decl;
     let virtual_ = (cld.ci_virt = Virtual) in
     let clparams =
···
   let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) in
   let open Signature in
   List.fold_left begin fun (acc, recursive) cld ->
-    let comments = Doc_attr.standalone_multiple container cld.ci_attributes in
+    let comments = Doc_attr.standalone_multiple container ~suppress_warnings:env.suppress_warnings cld.ci_attributes in
     let comments = List.map (fun com -> Comment com) comments in
     let cld = read_class_declaration env parent cld in
     ((Class (recursive, cld))::(List.rev_append comments acc), And)
···
               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
-                  Env.find_parameter_identifier env id, env
+                | Some id -> let e' = Env.add_parameter parent id (ModuleName.of_ident id) env.ident_env in
+                  Env.find_parameter_identifier e' id, {env with ident_env=e'}
               in
               let arg = Cmti.read_module_type env (id :> Identifier.Signature.t) label_parent arg in
 
···
       match mb.mb_id with
       | None -> None
       | Some id ->
-        let mid = Env.find_module_identifier env id in
+        let mid = Env.find_module_identifier env.ident_env id in
 #else
-  let mid = Env.find_module_identifier env mb.mb_id in
+  let mid = Env.find_module_identifier env.ident_env mb.mb_id in
 #endif
   let id = (mid :> Identifier.Module.t) in
   let source_loc = None in
   let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) in
-  let doc, canonical = Doc_attr.attached Odoc_model.Semantics.Expect_canonical container mb.mb_attributes in
+  let doc, canonical = Doc_attr.attached ~suppress_warnings:env.suppress_warnings Odoc_model.Semantics.Expect_canonical container mb.mb_attributes in
   let type_, canonical =
     match unwrap_module_expr_desc mb.mb_expr.mod_desc with
-    | Tmod_ident (p, _) -> (Alias (Env.Path.read_module env p, None), canonical)
+    | Tmod_ident (p, _) -> (Alias (Env.Path.read_module env.ident_env p, None), canonical)
     | _ ->
         let id = (id :> Identifier.Signature.t) in
         let expr, canonical =
···
   let open Signature in
   List.fold_left
     (fun (acc, recursive) mb ->
-      let comments = Doc_attr.standalone_multiple container mb.mb_attributes in
+      let comments = Doc_attr.standalone_multiple container ~suppress_warnings:env.suppress_warnings mb.mb_attributes in
       let comments = List.map (fun com -> Comment com) comments in
       match read_module_binding env parent mb with
       | Some mb ->
···
           Cmti.read_class_type_declarations env parent cltyps
     | Tstr_attribute attr ->
       let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) in
-          match Doc_attr.standalone container attr with
+          match Doc_attr.standalone container ~suppress_warnings:env.suppress_warnings attr with
           | None -> []
           | Some doc -> [Comment doc]
 
···
   let open Include in
   let loc = Doc_attr.read_location incl.incl_loc in
   let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) in
-  let doc, status = Doc_attr.attached Odoc_model.Semantics.Expect_status container incl.incl_attributes in
+  let doc, status = Doc_attr.attached ~suppress_warnings:env.suppress_warnings Odoc_model.Semantics.Expect_status container incl.incl_attributes in
   let decl_modty =
     match unwrap_module_expr_desc incl.incl_mod.mod_desc with
     | Tmod_ident(p, _) ->
-      let p = Env.Path.read_module env p in
+      let p = Env.Path.read_module env.ident_env p in
       Some (ModuleType.U.TypeOf (ModuleType.StructInclude p, p))
     | _ ->
       let mty = read_module_expr env parent container incl.incl_mod in
···
 
 and read_open env parent o =
   let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) in
-  let doc = Doc_attr.attached_no_tag container o.open_attributes in
+  let doc = Doc_attr.attached_no_tag ~suppress_warnings:env.suppress_warnings container o.open_attributes in
   #if OCAML_VERSION >= (4,8,0)
   let signature = o.open_bound_items in
   #else
···
       'tags. 'tags Odoc_model.Semantics.handle_internal_tags -> _ -> _ -> _ ->
       _ * 'tags =
  fun internal_tags env parent str ->
-  let env = Env.add_structure_tree_items parent str env in
+  let e' = Env.add_structure_tree_items parent str env.ident_env in
+  let env = { env with ident_env=e' } in
   let items, (doc, doc_post), tags =
     let classify item =
       match item.str_desc with
···
     |> List.rev
   in
   match doc_post with
-  | [] ->
+  | { elements = [] ; _} ->
     ({ Signature.items; compiled = false; removed = []; doc }, tags)
   | _ ->
     ({ Signature.items = Comment (`Docs doc_post) :: items; compiled=false; removed = []; doc }, tags)
 
-let read_implementation root name impl =
-  let id = Identifier.Mk.root (root, Odoc_model.Names.ModuleName.make_std name) in
+let read_implementation root name suppress_warnings 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
+      { ident_env = Env.empty (); suppress_warnings }
+      id impl
   in
-  let canonical = match canonical with | None -> None | Some s -> Some (Doc_attr.conv_canonical_module s) in
+  let canonical =
+    match canonical with
+    | None -> None
+    | Some s -> Some (Doc_attr.conv_canonical_module s)
+  in
   (id, sg, canonical)
 
 let _ = Cmti.read_module_expr := read_module_expr

src/loader/cmt.mli

···
 val read_implementation :
   Odoc_model.Paths.Identifier.ContainerPage.t option ->
   string ->
+  bool ->
   Typedtree.structure ->
   Odoc_model.Paths.Identifier.RootModule.t
   * Odoc_model.Lang.Signature.t

src/loader/cmti.ml

···
 module Env = Ident_env
 module Paths = Odoc_model.Paths
 
-let read_module_expr : (Ident_env.t -> Identifier.Signature.t -> Identifier.LabelParent.t -> Typedtree.module_expr -> ModuleType.expr) ref = ref (fun _ _ _ _ -> failwith "unset")
+type env = Cmi.env = {
+  ident_env : Ident_env.t;
+  suppress_warnings : bool;
+}
+
+let read_module_expr : (env -> Identifier.Signature.t -> Identifier.LabelParent.t -> Typedtree.module_expr -> ModuleType.expr) ref = ref (fun _ _ _ _ -> failwith "unset")
 
 let opt_map f = function
   | None -> None
···
         let typs = List.map (read_core_type env container) typs in
           Tuple typs
     | Ttyp_constr(p, _, params) ->
-        let p = Env.Path.read_type env p in
+        let p = Env.Path.read_type env.ident_env p in
         let params = List.map (read_core_type env container) params in
           Constr(p, params)
     | Ttyp_object(methods, closed) ->
···
         in
           Object {fields; open_ = (closed = Asttypes.Open)}
     | Ttyp_class(p, _, params) ->
-        let p = Env.Path.read_class_type env p in
+        let p = Env.Path.read_class_type env.ident_env p in
         let params = List.map (read_core_type env container) params in
           Class(p, params)
     | Ttyp_alias(typ, var) ->
···
 #if OCAML_VERSION >= (4,6,0)
                   let name = name.txt in
 #endif
-                let doc = Doc_attr.attached_no_tag container attributes in
+                let doc = Doc_attr.attached_no_tag ~suppress_warnings:env.suppress_warnings container attributes in
                 Constructor {name; constant; arguments; doc}
               | Tinherit typ -> Type (read_core_type env container typ)
           end
···
     | Ttyp_poly(vars, typ) -> Poly(vars, read_core_type env container typ)
     | Ttyp_package {pack_path; pack_fields; _} ->
         let open TypeExpr.Package in
-        let path = Env.Path.read_module_type env pack_path in
+        let path = Env.Path.read_module_type env.ident_env pack_path in
         let substitutions =
           List.map
             (fun (frag, typ) ->
···
 
 let read_value_description env parent vd =
   let open Signature in
-  let id = Env.find_value_identifier env vd.val_id in
+  let id = Env.find_value_identifier env.ident_env vd.val_id in
   let source_loc = None in
   let container =
     (parent : Identifier.Signature.t :> Identifier.LabelParent.t)
   in
-  let doc = Doc_attr.attached_no_tag container vd.val_attributes in
+  let doc = Doc_attr.attached_no_tag ~suppress_warnings:env.suppress_warnings container vd.val_attributes in
   let type_ = read_core_type env container vd.val_desc in
   let value =
     match vd.val_prim with
···
   let open Odoc_model.Names in
   let name = Ident.name ld.ld_id in
   let id = Identifier.Mk.field(parent, FieldName.make_std name) in
-  let doc = Doc_attr.attached_no_tag label_parent ld.ld_attributes in
+  let doc = Doc_attr.attached_no_tag ~suppress_warnings:env.suppress_warnings label_parent ld.ld_attributes in
   let mutable_ = (ld.ld_mutable = Mutable) in
   let type_ = read_core_type env label_parent ld.ld_type in
     {id; doc; mutable_; type_}
···
 
 let read_constructor_declaration env parent cd =
   let open TypeDecl.Constructor in
-  let id = Ident_env.find_constructor_identifier env cd.cd_id in
+  let id = Ident_env.find_constructor_identifier env.ident_env cd.cd_id in
   let container = (parent :> Identifier.FieldParent.t) in
   let label_container = (container :> Identifier.LabelParent.t) in
-  let doc = Doc_attr.attached_no_tag label_container cd.cd_attributes in
+  let doc = Doc_attr.attached_no_tag ~suppress_warnings:env.suppress_warnings label_container cd.cd_attributes in
   let args =
     read_constructor_declaration_arguments
       env container label_container cd.cd_args
···
 
 let read_type_declaration env parent decl =
   let open TypeDecl in
-  let id = Env.find_type_identifier env decl.typ_id in
+  let id = Env.find_type_identifier env.ident_env decl.typ_id in
   let source_loc = None in
   let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) in
-  let doc, canonical = Doc_attr.attached Odoc_model.Semantics.Expect_canonical container decl.typ_attributes in
+  let doc, canonical = Doc_attr.attached ~suppress_warnings:env.suppress_warnings Odoc_model.Semantics.Expect_canonical container decl.typ_attributes in
   let canonical = match canonical with | None -> None | Some s -> Doc_attr.conv_canonical_type s in
   let equation = read_type_equation env container decl in
   let representation = read_type_kind env id decl.typ_kind in
···
         then (acc, recursive)
         else begin
           let comments =
-            Doc_attr.standalone_multiple container decl.typ_attributes in
+            Doc_attr.standalone_multiple container ~suppress_warnings:env.suppress_warnings decl.typ_attributes in
            let comments = List.map (fun com -> Comment com) comments in
            let decl = read_type_declaration env parent decl in
            ((Type (recursive, decl)) :: (List.rev_append comments acc), And)
···
 
 let read_extension_constructor env parent ext =
   let open Extension.Constructor in
-  let id = Env.find_extension_identifier env ext.ext_id in
+  let id = Env.find_extension_identifier env.ident_env ext.ext_id in
   let source_loc = None in
   let container = (parent : Identifier.Signature.t :> Identifier.FieldParent.t) in
   let label_container = (container :> Identifier.LabelParent.t) in
-  let doc = Doc_attr.attached_no_tag label_container ext.ext_attributes in
+  let doc = Doc_attr.attached_no_tag ~suppress_warnings:env.suppress_warnings label_container ext.ext_attributes in
   match ext.ext_kind with
   | Text_rebind _ -> assert false
 #if OCAML_VERSION >= (4, 14, 0)
···
 
 let read_type_extension env parent tyext =
   let open Extension in
-  let type_path = Env.Path.read_type env tyext.tyext_path in
+  let type_path = Env.Path.read_type env.ident_env tyext.tyext_path in
   let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) in
-  let doc = Doc_attr.attached_no_tag container tyext.tyext_attributes in
+  let doc = Doc_attr.attached_no_tag ~suppress_warnings:env.suppress_warnings container tyext.tyext_attributes in
   let type_params = List.map read_type_parameter tyext.tyext_params in
   let private_ = (tyext.tyext_private = Private) in
   let constructors =
···
 
 let read_exception env parent (ext : extension_constructor) =
   let open Exception in
-  let id = Env.find_exception_identifier env ext.ext_id in
+  let id = Env.find_exception_identifier env.ident_env ext.ext_id in
   let source_loc = None in
   let container = (parent : Identifier.Signature.t :> Identifier.FieldParent.t) in
   let label_container = (container :> Identifier.LabelParent.t) in
-  let doc = Doc_attr.attached_no_tag label_container ext.ext_attributes in
+  let doc = Doc_attr.attached_no_tag ~suppress_warnings:env.suppress_warnings label_container ext.ext_attributes in
   match ext.ext_kind with
   | Text_rebind _ -> assert false
 #if OCAML_VERSION >= (4, 14, 0)
···
   let open ClassSignature in
   let open Odoc_model.Names in
   let container = (parent : Identifier.ClassSignature.t :> Identifier.LabelParent.t) in
-  let doc = Doc_attr.attached_no_tag container ctf.ctf_attributes in
+  let doc = Doc_attr.attached_no_tag ~suppress_warnings:env.suppress_warnings container ctf.ctf_attributes in
   match ctf.ctf_desc with
   | Tctf_val(name, mutable_, virtual_, typ) ->
       let open InstanceVariable in
···
       let expr = read_class_signature env parent container cltyp in
       Some (Inherit {expr; doc})
   | Tctf_attribute attr ->
-      match Doc_attr.standalone container attr with
+      match Doc_attr.standalone container ~suppress_warnings:env.suppress_warnings attr with
       | None -> None
       | Some doc -> Some (Comment doc)
 
···
   let open ClassType in
     match cltyp.cltyp_desc with
     | Tcty_constr(p, _, params) ->
-        let p = Env.Path.read_class_type env p in
+        let p = Env.Path.read_class_type env.ident_env p in
       let params = List.map (read_core_type env label_parent) params in
           Constr(p, params)
     | Tcty_signature csig ->
···
         let items, (doc, doc_post) = Doc_attr.extract_top_comment_class items in
         let items =
           match doc_post with
-          | [] -> items
+          | {elements=[]; _} -> items
           | _ -> Comment (`Docs doc_post) :: items
         in
         Signature {self; items; doc}
···
 
 let read_class_type_declaration env parent cltd =
   let open ClassType in
-  let id = Env.find_class_type_identifier env cltd.ci_id_class_type in
+  let id = Env.find_class_type_identifier env.ident_env cltd.ci_id_class_type in
   let source_loc = None in
   let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) in
-  let doc = Doc_attr.attached_no_tag container cltd.ci_attributes in
+  let doc = Doc_attr.attached_no_tag container ~suppress_warnings:env.suppress_warnings cltd.ci_attributes in
   let virtual_ = (cltd.ci_virt = Virtual) in
   let params = List.map read_type_parameter cltd.ci_params in
   let expr = read_class_signature env (id :> Identifier.ClassSignature.t) container cltd.ci_expr in
···
   let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) in
   let open Signature in
   List.fold_left begin fun (acc,recursive) cltd ->
-    let comments = Doc_attr.standalone_multiple container cltd.ci_attributes in
+    let comments = Doc_attr.standalone_multiple container ~suppress_warnings:env.suppress_warnings cltd.ci_attributes in
     let comments = List.map (fun com -> Comment com) comments in
     let cltd = read_class_type_declaration env parent cltd in
     ((ClassType (recursive, cltd))::(List.rev_append comments acc), And)
···
 
 let read_class_description env parent cld =
   let open Class in
-  let id = Env.find_class_identifier env cld.ci_id_class in
+  let id = Env.find_class_identifier env.ident_env cld.ci_id_class in
   let source_loc = None in
   let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) in
-  let doc = Doc_attr.attached_no_tag container cld.ci_attributes in
+  let doc = Doc_attr.attached_no_tag container ~suppress_warnings:env.suppress_warnings cld.ci_attributes in
   let virtual_ = (cld.ci_virt = Virtual) in
   let params = List.map read_type_parameter cld.ci_params in
   let type_ = read_class_type env (id :> Identifier.ClassSignature.t) container cld.ci_expr in
···
   let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) in
   let open Signature in
   List.fold_left begin fun (acc, recursive) cld ->
-    let comments = Doc_attr.standalone_multiple container cld.ci_attributes in
+    let comments = Doc_attr.standalone_multiple container ~suppress_warnings:env.suppress_warnings cld.ci_attributes in
     let comments = List.map (fun com -> Comment com) comments in
     let cld = read_class_description env parent cld in
     ((Class (recursive, cld))::(List.rev_append comments acc), And)
···
           TypeSubst(frag, eq)
     | Twith_modsubst(p, _) ->
         let frag = Env.Fragment.read_module frag.Location.txt in
-        let p = Env.Path.read_module env p in
+        let p = Env.Path.read_module env.ident_env p in
           ModuleSubst(frag, p)
 #if OCAML_VERSION >= (4,13,0)
     | Twith_modtype mty ->
···
 and read_module_type env parent label_parent mty =
   let open ModuleType in
     match mty.mty_desc with
-    | Tmty_ident(p, _) -> Path { p_path = Env.Path.read_module_type env p; p_expansion = None }
+    | Tmty_ident(p, _) -> Path { p_path = Env.Path.read_module_type env.ident_env p; p_expansion = None }
     | Tmty_signature sg ->
         let sg, () = read_signature Odoc_model.Semantics.Expect_none env parent sg in
         Signature sg
···
               match id_opt with
               | None -> Identifier.Mk.parameter (parent, 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
+                 let e' = Env.add_parameter parent id (ModuleName.of_ident id) env.ident_env in
+                 let env = {env with ident_env = e'} in
+                 Env.find_parameter_identifier e' id, env
             in
             let arg = read_module_type env (id :> Identifier.Signature.t) label_parent arg in
             Named { id; expr = arg; }, env
···
         let decl =
           match mexpr.mod_desc with
           | Tmod_ident(p, _) ->
-            let p = Env.Path.read_module env p in
+            let p = Env.Path.read_module env.ident_env p in
             TypeOf {t_desc = ModPath p; t_original_path = p; t_expansion = None}
           | Tmod_structure {str_items = [{str_desc = Tstr_include {incl_mod; _}; _}]; _} -> begin
             match Typemod.path_of_module incl_mod with
               | Some p ->
-                let p = Env.Path.read_module env p in
+                let p = Env.Path.read_module env.ident_env p in
                 TypeOf {t_desc=StructInclude p; t_original_path = p; t_expansion = None}
             | None ->
               !read_module_expr env parent label_parent mexpr 
···
 
 and read_module_type_declaration env parent mtd =
   let open ModuleType in
-  let id = Env.find_module_type env mtd.mtd_id in
+  let id = Env.find_module_type env.ident_env mtd.mtd_id in
   let source_loc = None in
   let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) in
-  let doc, canonical = Doc_attr.attached Odoc_model.Semantics.Expect_canonical container mtd.mtd_attributes in
+  let doc, canonical = Doc_attr.attached ~suppress_warnings:env.suppress_warnings Odoc_model.Semantics.Expect_canonical container mtd.mtd_attributes in
   let expr, canonical =
     match mtd.mtd_type with
     | Some mty ->
···
   match md.md_id with
   | None -> None
   | Some id ->
-  let mid = Env.find_module_identifier env id in
+  let mid = Env.find_module_identifier env.ident_env id in
 #else
-  let mid = Env.find_module_identifier env md.md_id in
+  let mid = Env.find_module_identifier env.ident_env md.md_id in
 #endif
   let id = (mid :> Identifier.Module.t) in
   let source_loc = None in
   let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) in
-  let doc, canonical = Doc_attr.attached Odoc_model.Semantics.Expect_canonical container md.md_attributes in
+  let doc, canonical = Doc_attr.attached ~suppress_warnings:env.suppress_warnings Odoc_model.Semantics.Expect_canonical container md.md_attributes in
   let type_, canonical =
     match md.md_type.mty_desc with
-    | Tmty_alias (p, _) -> (Alias (Env.Path.read_module env p, None), canonical)
+    | Tmty_alias (p, _) -> (Alias (Env.Path.read_module env.ident_env p, None), canonical)
     | _ ->
         let expr, canonical =
           read_module_type_maybe_canonical env
···
   let open Signature in
   List.fold_left
     (fun (acc, recursive) md ->
-      let comments = Doc_attr.standalone_multiple container md.md_attributes in
+      let comments = Doc_attr.standalone_multiple container ~suppress_warnings:env.suppress_warnings md.md_attributes in
       let comments = List.map (fun com -> Comment com) comments in
       match read_module_declaration env parent md with
       | Some md -> ((Module (recursive, md))::(List.rev_append comments acc), And)
···
 
 and read_module_equation env p =
   let open Module in
-    Alias (Env.Path.read_module env p, None)
+    Alias (Env.Path.read_module env.ident_env p, None)
 
 and read_signature_item env parent item =
   let open Signature in
···
         read_class_type_declarations env parent cltyps
     | Tsig_attribute attr -> begin
         let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) in
-          match Doc_attr.standalone container attr with
+          match Doc_attr.standalone container ~suppress_warnings:env.suppress_warnings attr with
           | None -> []
           | Some doc -> [Comment doc]
       end
···
 
 and read_module_substitution env parent ms =
   let open ModuleSubstitution in
-  let id = Env.find_module_identifier env ms.ms_id in
+  let id = Env.find_module_identifier env.ident_env ms.ms_id in
   let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) in
-  let doc, () = Doc_attr.attached Odoc_model.Semantics.Expect_none container ms.ms_attributes in
-  let manifest = Env.Path.read_module env ms.ms_manifest in
+  let doc, () = Doc_attr.attached ~suppress_warnings:env.suppress_warnings Odoc_model.Semantics.Expect_none container ms.ms_attributes in
+  let manifest = Env.Path.read_module env.ident_env ms.ms_manifest in
   { id; doc; manifest }
 
 #if OCAML_VERSION >= (4,13,0)
 and read_module_type_substitution env parent mtd =
   let open ModuleTypeSubstitution in
-  let id = Env.find_module_type env mtd.mtd_id in
+  let id = Env.find_module_type env.ident_env mtd.mtd_id in
   let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) in
-  let doc, () = Doc_attr.attached Odoc_model.Semantics.Expect_none container mtd.mtd_attributes in
+  let doc, () = Doc_attr.attached ~suppress_warnings:env.suppress_warnings Odoc_model.Semantics.Expect_none container mtd.mtd_attributes in
   let expr = match opt_map (read_module_type env (id :> Identifier.Signature.t) container) mtd.mtd_type with
     | None -> assert false
     | Some x -> x
···
   let open Include in
   let loc = Doc_attr.read_location incl.incl_loc in
   let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) in
-  let doc, status = Doc_attr.attached Odoc_model.Semantics.Expect_status container incl.incl_attributes in
+  let doc, status = Doc_attr.attached ~suppress_warnings:env.suppress_warnings Odoc_model.Semantics.Expect_status container incl.incl_attributes in
   let content, shadowed = Cmi.read_signature_noenv env parent (Odoc_model.Compat.signature incl.incl_type) in
   let expr = read_module_type env parent container incl.incl_mod in
   let umty = Odoc_model.Lang.umty_of_mty expr in 
···
 
 and read_open env parent o =
   let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) in
-  let doc = Doc_attr.attached_no_tag container o.open_attributes in
+  let doc = Doc_attr.attached_no_tag container ~suppress_warnings:env.suppress_warnings o.open_attributes in
   #if OCAML_VERSION >= (4,8,0)
   let signature = o.open_bound_items in
   #else
···
       'tags. 'tags Odoc_model.Semantics.handle_internal_tags -> _ -> _ -> _ ->
       _ * 'tags =
  fun internal_tags env parent sg ->
-  let env = Env.add_signature_tree_items parent sg env in
+  let e' = Env.add_signature_tree_items parent sg env.ident_env in
+  let env = { env with ident_env = e' } in
   let items, (doc, doc_post), tags =
     let classify item =
       match item.sig_desc with
···
     |> List.rev
   in
   match doc_post with
-  | [] ->
+  | {elements=[]; _} ->
     ({ Signature.items; compiled = false; removed = []; doc }, tags)
   | _ ->
     ({ Signature.items = Comment (`Docs doc_post) :: items; compiled=false; removed = []; doc }, tags)
 
-let read_interface root name intf =
-  let id = Identifier.Mk.root (root, Odoc_model.Names.ModuleName.make_std name) in
+let read_interface root name suppress_warnings 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
+      { ident_env = Env.empty (); suppress_warnings }
+      id intf
   in
-  let canonical = match canonical with | None -> None | Some s -> Some (Doc_attr.conv_canonical_module s) in
+  let canonical =
+    match canonical with
+    | None -> None
+    | Some s -> Some (Doc_attr.conv_canonical_module s)
+  in
   (id, sg, canonical)

src/loader/cmti.mli

···
 module Paths = Odoc_model.Paths
 
 val read_module_expr :
-  (Ident_env.t ->
+  (Cmi.env ->
   Paths.Identifier.Signature.t ->
   Paths.Identifier.LabelParent.t ->
   Typedtree.module_expr ->
···
 val read_interface :
   Odoc_model.Paths.Identifier.ContainerPage.t option ->
   string ->
+  bool ->
   Typedtree.signature ->
   Paths.Identifier.RootModule.t
   * Odoc_model.Lang.Signature.t
···
     [@canonical] tag. *)
 
 val read_module_type :
-  Ident_env.t ->
+  Cmi.env ->
   Paths.Identifier.Signature.t ->
   Paths.Identifier.LabelParent.t ->
   Typedtree.module_type ->
   Odoc_model.Lang.ModuleType.expr
 
 val read_value_description :
-  Ident_env.t ->
+  Cmi.env ->
   Paths.Identifier.Signature.t ->
   Typedtree.value_description ->
   Odoc_model.Lang.Signature.item
 
 val read_type_declarations :
-  Ident_env.t ->
+  Cmi.env ->
   Paths.Identifier.Signature.t ->
   Odoc_model.Lang.Signature.recursive ->
   Typedtree.type_declaration list ->
   Odoc_model.Lang.Signature.item list
 
 val read_module_type_declaration :
-  Ident_env.t ->
+  Cmi.env ->
   Paths.Identifier.Signature.t ->
   Typedtree.module_type_declaration ->
   Odoc_model.Lang.ModuleType.t
 
 val read_class_type_declarations :
-  Ident_env.t ->
+  Cmi.env ->
   Paths.Identifier.Signature.t ->
   Typedtree.class_type Typedtree.class_infos list ->
   Odoc_model.Lang.Signature.item list

src/loader/doc_attr.ml

···
     end_ = point_of_pos loc_end;
   }
 
-let empty_body = []
+let empty_body = { Comment.elements = []; suppress_warnings = false }
 
 let empty : Odoc_model.Comment.docs = empty_body
 
···
   let span = read_location loc in
   Location_.at span elt
 
-let attached internal_tags parent attrs =
+let attached ~suppress_warnings internal_tags parent attrs =
   let rec loop acc_docs acc_alerts = function
     | attr :: rest -> (
         match parse_attribute attr with
···
     | [] -> (List.rev acc_docs, List.rev acc_alerts)
   in
   let ast_docs, alerts = loop [] [] attrs in
-  ast_to_comment ~internal_tags parent ast_docs alerts
+  let elements, warnings = ast_to_comment ~internal_tags parent ast_docs alerts in
+  { Comment.elements; suppress_warnings }, warnings
 
-let attached_no_tag parent attrs =
-  let x, () = attached Semantics.Expect_none parent attrs in
+let attached_no_tag ~suppress_warnings parent attrs =
+  let x, () = attached ~suppress_warnings Semantics.Expect_none parent attrs in
   x
 
 let read_string ~tags_allowed internal_tags parent location str =
···
   read_string ~tags_allowed:true internal_tags parent (pad_loc loc) str
 
 let page parent loc str =
-    read_string ~tags_allowed:false Odoc_model.Semantics.Expect_page_tags parent loc.Location.loc_start
+  let elements, tags = read_string ~tags_allowed:false Odoc_model.Semantics.Expect_page_tags parent loc.Location.loc_start
       str
+  in
+  { Comment.elements; suppress_warnings = false}, tags
 
-let standalone parent (attr : Parsetree.attribute) :
+let standalone parent ~suppress_warnings (attr : Parsetree.attribute) :
     Odoc_model.Comment.docs_or_stop option =
   match parse_attribute attr with
   | Some (`Stop _loc) -> Some `Stop
   | Some (`Text (str, loc)) ->
-      let doc, () = read_string_comment Semantics.Expect_none parent loc str in
-      Some (`Docs doc)
+      let elements, () = read_string_comment Semantics.Expect_none parent loc str in
+      Some (`Docs { elements; suppress_warnings })
   | Some (`Doc _) -> None
   | Some (`Alert (name, _, attr_loc)) ->
       let w =
-        Error.make "Alert %s not expected here." name
-          (read_location attr_loc)
+        Error.make "Alert %s not expected here." name (read_location attr_loc)
       in
       Error.raise_warning w;
       None
   | _ -> None
 
-let standalone_multiple parent attrs =
+let standalone_multiple parent ~suppress_warnings attrs =
   let coms =
     List.fold_left
       (fun acc attr ->
-        match standalone parent attr  with
+        match standalone parent ~suppress_warnings attr  with
          | None -> acc
          | Some com -> com :: acc)
       [] attrs
···
       (parent : Paths.Identifier.Signature.t :> Paths.Identifier.LabelParent.t)
       ast_docs alerts
   in
-  (items, split_docs docs, tags)
+  let d1, d2 = split_docs docs in
+  ( items,
+    ( { Comment.elements = d1; suppress_warnings = false },
+      { Comment.elements = d2; suppress_warnings = false } ),
+    tags )
 
 let extract_top_comment_class items =
+  let mk elements suppress_warnings = { Comment.elements; suppress_warnings } in
   match items with
-  | Lang.ClassSignature.Comment (`Docs doc) :: tl -> (tl, split_docs doc)
-  | _ -> items, (empty,empty)
+  | Lang.ClassSignature.Comment (`Docs doc) :: tl ->
+      let d1, d2 = split_docs doc.elements in
+      (tl, (mk d1 doc.suppress_warnings, mk d2 doc.suppress_warnings))
+  | _ -> (items, (mk [] false, mk [] false))
 
 let rec conv_canonical_module : Odoc_model.Reference.path -> Paths.Path.Module.t = function
   | `Dot (parent, name) -> `Dot (conv_canonical_module parent, Names.ModuleName.make_std name)

src/loader/doc_attr.mli

···
 val is_stop_comment : Parsetree.attribute -> bool
 
 val attached :
+  suppress_warnings:bool ->
   'tags Semantics.handle_internal_tags ->
   Paths.Identifier.LabelParent.t ->
   Parsetree.attributes ->
   Odoc_model.Comment.docs * 'tags
 
 val attached_no_tag :
+  suppress_warnings:bool ->
   Paths.Identifier.LabelParent.t ->
   Parsetree.attributes ->
   Odoc_model.Comment.docs
···
 
 val standalone :
   Paths.Identifier.LabelParent.t ->
+  suppress_warnings:bool ->
   Parsetree.attribute ->
   Odoc_model.Comment.docs_or_stop option
 
 val standalone_multiple :
   Paths.Identifier.LabelParent.t ->
+  suppress_warnings:bool ->
   Parsetree.attributes ->
   Odoc_model.Comment.docs_or_stop list
 

src/loader/odoc_loader.ml

···
   make_compilation_unit ~make_root ~imports ~interface ?sourcefile ~name ~id
     ?canonical content
 
-let read_cmti ~make_root ~parent ~filename () =
+let read_cmti ~make_root ~parent ~filename ~suppress_warnings () =
   let cmt_info = Cmt_format.read_cmt filename in
   match cmt_info.cmt_annots with
   | Interface intf -> (
···
               cmt_info.cmt_source_digest,
               cmt_info.cmt_builddir )
           in
-          let id, sg, canonical = Cmti.read_interface parent name intf in
+          let id, sg, canonical =
+            Cmti.read_interface parent name suppress_warnings intf
+          in
           compilation_unit_of_sig ~make_root ~imports:cmt_info.cmt_imports
             ~interface ~sourcefile ~name ~id ?canonical sg)
   | _ -> raise Not_an_interface
 
-let read_cmt ~make_root ~parent ~filename () =
+let read_cmt ~make_root ~parent ~filename ~suppress_warnings () =
   match Cmt_format.read_cmt filename with
   | exception Cmi_format.Error (Not_an_interface _) ->
       raise Not_an_implementation
···
           make_compilation_unit ~make_root ~imports ~interface ~sourcefile ~name
             ~id content
       | Implementation impl ->
-          let id, sg, canonical = Cmt.read_implementation parent name impl in
+          let id, sg, canonical =
+            Cmt.read_implementation parent name suppress_warnings impl
+          in
           compilation_unit_of_sig ~make_root ~imports ~interface ~sourcefile
             ~name ~id ?canonical sg
       | _ -> raise Not_an_implementation)
 
-let read_cmi ~make_root ~parent ~filename () =
+let read_cmi ~make_root ~parent ~filename ~suppress_warnings () =
   let cmi_info = Cmi_format.read_cmi filename in
   match cmi_info.cmi_crcs with
   | (name, (Some _ as interface)) :: imports when name = cmi_info.cmi_name ->
       let id, sg =
-        Cmi.read_interface parent name
+        Cmi.read_interface parent name suppress_warnings
           (Odoc_model.Compat.signature cmi_info.cmi_sign)
       in
       compilation_unit_of_sig ~make_root ~imports ~interface ~name ~id sg
···
       | Not_an_interface -> not_an_interface filename
       | Make_root_error m -> error_msg filename m)
 
-let read_cmti ~make_root ~parent ~filename =
-  wrap_errors ~filename (read_cmti ~make_root ~parent ~filename)
+let read_cmti ~make_root ~parent ~filename ~suppress_warnings =
+  wrap_errors ~filename
+    (read_cmti ~make_root ~parent ~filename ~suppress_warnings)
 
-let read_cmt ~make_root ~parent ~filename =
-  wrap_errors ~filename (read_cmt ~make_root ~parent ~filename)
+let read_cmt ~make_root ~parent ~filename ~suppress_warnings =
+  wrap_errors ~filename
+    (read_cmt ~make_root ~parent ~filename ~suppress_warnings)
 
 let read_impl ~make_root ~filename ~source_id =
   wrap_errors ~filename (read_impl ~make_root ~source_id ~filename)
 
-let read_cmi ~make_root ~parent ~filename =
-  wrap_errors ~filename (read_cmi ~make_root ~parent ~filename)
+let read_cmi ~make_root ~parent ~filename ~suppress_warnings =
+  wrap_errors ~filename
+    (read_cmi ~make_root ~parent ~filename ~suppress_warnings)
 
 let read_location = Doc_attr.read_location

src/loader/odoc_loader.mli

···
   make_root:make_root ->
   parent:Identifier.ContainerPage.t option ->
   filename:string ->
+  suppress_warnings:bool ->
   (Lang.Compilation_unit.t, Error.t) result Error.with_warnings
 
 val read_cmt :
   make_root:make_root ->
   parent:Identifier.ContainerPage.t option ->
   filename:string ->
+  suppress_warnings:bool ->
   (Lang.Compilation_unit.t, Error.t) result Error.with_warnings
 
 val read_impl :
···
   make_root:make_root ->
   parent:Identifier.ContainerPage.t option ->
   filename:string ->
+  suppress_warnings:bool ->
   (Lang.Compilation_unit.t, Error.t) result Error.with_warnings
 
 val read_location : Location.t -> Location_.span

src/markdown/odoc_md.ml

···
   in
   (content, List.map Error.t_of_parser_t parser_warnings @ semantics_warnings)
 
-let mk_page input_s id content =
+let mk_page input_s id elements =
   (* Construct the output file representation *)
-  let zero_heading = Comment.find_zero_heading content in
+  let zero_heading = Comment.find_zero_heading elements in
   let frontmatter = Frontmatter.empty in
   let digest = Digest.file input_s in
   let root =
···
     Lang.Page.name = id;
     root;
     children;
-    content;
+    content = { elements; suppress_warnings = false };
     digest;
     linked = false;
     frontmatter;

src/model/comment.ml

···
     heading_attrs * Identifier.Label.t * inline_element with_location list
   | `Tag of tag ]
 
-type docs = block_element with_location list
+type elements = block_element with_location list
+
+type docs = { elements : elements; suppress_warnings : bool }
 
 type docs_or_stop = [ `Docs of docs | `Stop ]
 

src/model/error.ml

···
 
 let print_errors = List.iter print_error
 
-type warnings_options = { warn_error : bool; print_warnings : bool }
+type warnings_options = {
+  warn_error : bool;
+  print_warnings : bool;
+  suppress_warnings : bool;
+}
 
 let print_warnings ~warnings_options warnings =
   if warnings_options.print_warnings then

src/model/error.mli

···
 type warnings_options = {
   warn_error : bool;  (** If [true], warnings will result in an error. *)
   print_warnings : bool;  (** Whether to print warnings. *)
+  suppress_warnings : bool;  (** Whether to suppress warnings. *)
 }
 
 val handle_warnings :

src/model/lang.ml

···
     | { decl = ModuleType expr; _ } -> uexpr_considered_hidden expr
   in
   match (s.doc, s.items) with
-  | [], Include inc :: _ when should_take_top inc -> inc.expansion.content.doc
+  | { elements = []; _ }, Include inc :: _ when should_take_top inc ->
+      inc.expansion.content.doc
   | doc, _ -> doc

src/model/semantics.ml

···
           comment)
       alerts
   in
-  comment @ (alerts : alerts :> Comment.docs)
+  comment @ (alerts :> Comment.elements)
 
 let handle_internal_tags (type a) tags : a handle_internal_tags -> a = function
   | Expect_status -> (

src/model/semantics.mli

···
   parent_of_sections:Paths.Identifier.LabelParent.t ->
   Odoc_parser.Ast.t ->
   alerts ->
-  (Comment.docs * 'tags) Error.with_warnings
+  (Comment.elements * 'tags) Error.with_warnings
 
 val non_link_inline_element :
   context:string ->
···
   containing_definition:Paths.Identifier.LabelParent.t ->
   location:Lexing.position ->
   text:string ->
-  (Comment.docs * 'tags) Error.with_warnings
+  (Comment.elements * 'tags) Error.with_warnings
 
 val parse_reference : string -> Paths.Reference.t Error.with_errors_and_warnings

src/model_desc/comment_desc.ml

···
     Comment.heading_attrs * Identifier.Label.t * general_link_content
   | `Tag of general_tag
   | `Media of
-    [ `Reference of Paths.Reference.t | `Link of string ] * media * string
-  | `MediaLink of string * media * general_link_content ]
+    [ `Reference of Paths.Reference.t | `Link of string ] * media * string ]
 
 and general_tag =
   [ `Author of string
···
     | `Verbatim x -> C ("`Verbatim", x, string)
     | `Modules x -> C ("`Modules", x, List module_reference)
     | `List (x1, x2) ->
-        C ("`List", (x1, (x2 :> general_docs list)), Pair (list_kind, List docs))
+        C
+          ( "`List",
+            (x1, (x2 :> general_docs list)),
+            Pair (list_kind, List general_content) )
     | `Table { data; align } ->
         let cell_type_desc =
           Variant (function `Header -> C0 "`Header" | `Data -> C0 "`Data")
         in
-        let data_desc = List (List (Pair (docs, cell_type_desc))) in
+        let data_desc = List (List (Pair (general_content, cell_type_desc))) in
         let align_desc =
           Option
             (Variant
···
     | `Heading h -> C ("`Heading", h, heading)
     | `Tag x -> C ("`Tag", x, tag)
     | `Media (x1, m, x2) ->
-        C ("`MediaReference", (x1, m, x2), Triple (media_href, media, string))
-    | `MediaLink (x1, m, x2) ->
-        C ("`MediaLink", (x1, m, x2), Triple (string, media, link_content)))
+        C ("`Media", (x1, m, x2), Triple (media_href, media, string)))
 
 and tag : general_tag t =
   let url_kind =
···
   Variant
     (function
     | `Author x -> C ("`Author", x, string)
-    | `Deprecated x -> C ("`Deprecated", x, docs)
-    | `Param (x1, x2) -> C ("`Param", (x1, x2), Pair (string, docs))
+    | `Deprecated x -> C ("`Deprecated", x, general_content)
+    | `Param (x1, x2) -> C ("`Param", (x1, x2), Pair (string, general_content))
     | `Raise (x1, x2) ->
         C
           ( "`Raise",
             ((x1 :> general_inline_element), x2),
-            Pair (inline_element, docs) )
-    | `Return x -> C ("`Return", x, docs)
+            Pair (inline_element, general_content) )
+    | `Return x -> C ("`Return", x, general_content)
     | `See (x1, x2, x3) ->
-        C ("`See", (x1, x2, x3), Triple (url_kind, string, docs))
+        C ("`See", (x1, x2, x3), Triple (url_kind, string, general_content))
     | `Since x -> C ("`Since", x, string)
-    | `Before (x1, x2) -> C ("`Before", (x1, x2), Pair (string, docs))
+    | `Before (x1, x2) -> C ("`Before", (x1, x2), Pair (string, general_content))
     | `Version x -> C ("`Version", x, string)
     | `Alert (x1, x2) -> C ("`Alert", (x1, x2), Pair (string, Option string)))
 
-and docs : general_docs t = List (Indirect (ignore_loc, block_element))
+and general_content : general_docs t =
+  List (Indirect (ignore_loc, block_element))
 
-let docs = Indirect ((fun n -> ((n :> docs) :> general_docs)), docs)
+let elements : elements t =
+  Indirect ((fun x -> (x :> general_docs)), general_content)
+let docs =
+  Record
+    [
+      F ("elements", (fun h -> h.elements), elements);
+      F ("suppress_warnings", (fun h -> h.suppress_warnings), bool);
+    ]
 
 let docs_or_stop : docs_or_stop t =
   Variant (function `Docs x -> C ("`Docs", x, docs) | `Stop -> C0 "`Stop")

src/model_desc/comment_desc.mli

···
 open Odoc_model
 open Odoc_model.Comment
 
-val docs : docs Type_desc.t
+val inline_element : inline_element Location_.with_location list Type_desc.t
 
-val inline_element : inline_element Location_.with_location list Type_desc.t
+val elements : elements Type_desc.t
+
+val docs : docs Type_desc.t
 
 val docs_or_stop : docs_or_stop Type_desc.t

src/odoc/bin/main.ml

···
     let env = Arg.env_var "ODOC_ENABLE_MISSING_ROOT_WARNING" ~doc in
     Arg.(value & flag & info ~docs ~doc ~env [ "enable-missing-root-warning" ])
   in
+  let suppress_warnings =
+    let doc =
+      "Suppress warnings. This is useful when you want to declare that \
+       warnings that would be generated resolving the references defined in \
+       this unit should be ignored if they end up in expansions in other \
+       units."
+    in
+    let env = Arg.env_var "ODOC_SUPPRESS_WARNINGS" ~doc in
+    Arg.(value & flag & info ~docs ~doc ~env [ "suppress-warnings" ])
+  in
   Term.(
-    const (fun warn_error print_warnings enable_missing_root_warning ->
+    const
+      (fun
+        warn_error
+        print_warnings
+        enable_missing_root_warning
+        suppress_warnings
+      ->
         Odoc_model.Error.enable_missing_root_warning :=
           enable_missing_root_warning;
-        { Odoc_model.Error.warn_error; print_warnings })
-    $ warn_error $ print_warnings $ enable_missing_root_warning)
+        { Odoc_model.Error.warn_error; print_warnings; suppress_warnings })
+    $ warn_error $ print_warnings $ enable_missing_root_warning
+    $ suppress_warnings)
 
 let dst ?create () =
   let doc = "Output directory where the HTML tree is expected to be saved." in
···
           ~roots:None
       in
       let warnings_options =
-        { Odoc_model.Error.warn_error = false; print_warnings = false }
+        {
+          Odoc_model.Error.warn_error = false;
+          print_warnings = false;
+          suppress_warnings = false;
+        }
       in
       Rendering.targets_odoc ~resolver ~warnings_options ~syntax:OCaml
         ~renderer:R.renderer ~output:output_dir ~extra odoc_file
···
   module Targets_source = struct
     let list_targets output_dir source_file extra odoc_file =
       let warnings_options =
-        { Odoc_model.Error.warn_error = false; print_warnings = false }
+        {
+          Odoc_model.Error.warn_error = false;
+          print_warnings = false;
+          suppress_warnings = false;
+        }
       in
       Rendering.targets_source_odoc ~warnings_options ~syntax:OCaml
         ~renderer:R.renderer ~output:output_dir ~extra ~source_file odoc_file

src/odoc/compile.ml

···
     imports
 
 (** Raises warnings and errors. *)
-let resolve_and_substitute ~resolver ~make_root ~hidden
+let resolve_and_substitute ~resolver ~make_root ~hidden ~suppress_warnings
     (parent : Paths.Identifier.ContainerPage.t option) input_file input_type =
   let filename = Fs.File.to_string input_file in
   let unit =
     match input_type with
     | `Cmti ->
-        Odoc_loader.read_cmti ~make_root ~parent ~filename
+        Odoc_loader.read_cmti ~make_root ~parent ~filename ~suppress_warnings
         |> Error.raise_errors_and_warnings
     | `Cmt ->
-        Odoc_loader.read_cmt ~make_root ~parent ~filename
+        Odoc_loader.read_cmt ~make_root ~parent ~filename ~suppress_warnings
         |> Error.raise_errors_and_warnings
     | `Cmi ->
-        Odoc_loader.read_cmi ~make_root ~parent ~filename
+        Odoc_loader.read_cmi ~make_root ~parent ~filename ~suppress_warnings
         |> Error.raise_errors_and_warnings
   in
   let unit = { unit with hidden = hidden || unit.hidden } in
···
      >>= fun id -> Ok (id :> Paths.Identifier.Page.t))
   >>= fun id ->
   let resolve content frontmatter =
-    let zero_heading = Comment.find_zero_heading content in
+    let zero_heading = Comment.find_zero_heading content.Comment.elements in
     if (not (is_index_page id)) && has_children_order frontmatter then
       Error.raise_warning
         (Error.filename_only "Non-index page cannot specify @children_order."
···
     in
     let result =
       Error.catch_errors_and_warnings (fun () ->
-          resolve_and_substitute ~resolver ~make_root ~hidden parent_id input
-            input_type)
+          resolve_and_substitute ~resolver ~make_root ~hidden
+            ~suppress_warnings:warnings_options.suppress_warnings parent_id
+            input input_type)
     in
     (* Extract warnings to write them into the output file *)
     let _, warnings = Error.unpack_warnings result in

src/odoc/odoc_link.ml

···
       `Word "hidden.";
     ]
   in
-  [ Comment (`Docs [ with_loc @@ `Paragraph (List.map with_loc sentence) ]) ]
+  [
+    Comment
+      (`Docs
+        {
+          elements = [ with_loc @@ `Paragraph (List.map with_loc sentence) ];
+          suppress_warnings = true;
+        });
+  ]
 
 let link_unit ~resolver ~filename m =
   let open Odoc_model in
···
               items = content_for_hidden_modules;
               compiled = false;
               removed = [];
-              doc = [];
+              doc = { elements = []; suppress_warnings = false };
             };
         expansion = None;
       }

src/odoc/url.ml

···
   in
   let reference =
     let open Odoc_model in
-    let warnings_options = { Error.warn_error = true; print_warnings = true } in
+    let warnings_options =
+      {
+        Error.warn_error = true;
+        print_warnings = true;
+        suppress_warnings = false;
+      }
+    in
     Semantics.parse_reference reference
     |> Error.handle_errors_and_warnings ~warnings_options
   in

src/search/text.ml

···
   let get_value x = x.Odoc_model.Location_.value
 
   let rec string_of_doc (doc : Odoc_model.Comment.docs) =
-    doc |> List.map get_value
+    doc.elements |> List.map get_value
     |> List.map s_of_block_element
     |> String.concat "\n"
 

src/xref2/compile.ml

···
                 Component.Delayed.(
                   put (fun () -> Component.Of_Lang.(module_ (empty ()) m)))
               in
-              Env.add_module (m.id :> Paths.Identifier.Path.Module.t) ty [] env
+              Env.add_module
+                (m.id :> Paths.Identifier.Path.Module.t)
+                ty
+                { elements = []; suppress_warnings = false }
+                env
             in
             let env =
               match r with

src/xref2/component.ml

···
     | `Media of
       Odoc_model.Comment.media_href * Odoc_model.Comment.media * string ]
 
-  type docs = block_element Odoc_model.Comment.with_location list
+  type docs = {
+    elements : block_element Odoc_model.Comment.with_location list;
+    suppress_warnings : bool;
+  }
 
   type docs_or_stop = [ `Docs of docs | `Stop ]
 end =
···
     | { value = `Tag _ | `Media _; _ } as t -> t
     | { value = #Odoc_model.Comment.nestable_block_element; _ } as n -> n
 
-  and docs ident_map d = List.map (block_element ident_map) d
+  and docs ident_map d =
+    {
+      elements = List.map (block_element ident_map) d.elements;
+      suppress_warnings = d.suppress_warnings;
+    }
 
   and docs_or_stop ident_map = function
     | `Docs d -> `Docs (docs ident_map d)
···
 let module_of_functor_argument (arg : FunctorParameter.parameter) =
   {
     Module.source_loc = None;
-    doc = [];
+    doc = { elements = []; suppress_warnings = false };
     type_ = ModuleType arg.expr;
     canonical = None;
     hidden = false;
···
 (** This is equivalent to {!Lang.extract_signature_doc}. *)
 let extract_signature_doc (s : Signature.t) =
   match (s.doc, s.items) with
-  | [], Include { expansion_; status = `Inline; _ } :: _ -> expansion_.doc
+  | { elements = []; _ }, Include { expansion_; status = `Inline; _ } :: _ ->
+      expansion_.doc
   | doc, _ -> doc

src/xref2/component.mli

···
     | `Media of
       Odoc_model.Comment.media_href * Odoc_model.Comment.media * string ]
 
-  type docs = block_element Odoc_model.Comment.with_location list
+  type docs = {
+    elements : block_element Odoc_model.Comment.with_location list;
+    suppress_warnings : bool;
+  }
 
   type docs_or_stop = [ `Docs of docs | `Stop ]
 end

src/xref2/env.ml

···
           let label = Ident.Of_Identifier.label id in
           add_label id { Component.Label.attrs; label; text; location } env
       | _ -> env)
-    env docs
+    env docs.elements
 
 let add_comment (com : Comment.docs_or_stop) env =
   match com with `Docs doc -> add_docs doc env | `Stop -> env
···
           in
           add_label label h env
       | _ -> env)
-    env docs
+    env docs.elements
 
 let add_module identifier m docs env =
   let env' = add_to_elts Kind_Module identifier (`Module (identifier, m)) env in
···
           {
             id;
             source_loc = None;
-            doc = [];
+            doc = { elements = []; suppress_warnings = false };
             type_ = ModuleType (Signature s);
             canonical = unit.canonical;
             hidden = unit.hidden;
···
           {
             id;
             source_loc = None;
-            doc = [];
+            doc = { elements = []; suppress_warnings = false };
             type_ =
               ModuleType
                 (Signature
-                   { items = []; compiled = true; removed = []; doc = [] });
+                   {
+                     items = [];
+                     compiled = true;
+                     removed = [];
+                     doc = { elements = []; suppress_warnings = false };
+                   });
             canonical = unit.canonical;
             hidden = unit.hidden;
           }
···
 let mk_functor_parameter module_type =
   let type_ = Component.Module.ModuleType module_type in
   Component.Module.
-    { source_loc = None; doc = []; type_; canonical = None; hidden = false }
+    {
+      source_loc = None;
+      doc = { elements = []; suppress_warnings = false };
+      type_;
+      canonical = None;
+      hidden = false;
+    }
 
 let add_functor_parameter : Lang.FunctorParameter.t -> t -> t =
  fun p t ->
···
         let open Component.Of_Lang in
         mk_functor_parameter (module_type_expr (empty ()) n.expr)
       in
-      add_module id (Component.Delayed.put_val m) [] t
+      add_module id
+        (Component.Delayed.put_val m)
+        { elements = []; suppress_warnings = false }
+        t
 
 let add_functor_args' :
     Paths.Identifier.Signature.t -> Component.ModuleType.expr -> t -> t =

src/xref2/find.ml

···
         | Some r -> Some (`In_type (N.typed_type id, typ, r))
         | None -> None)
     | TypExt typext -> any_in_typext typext name
-    | Comment (`Docs d) -> any_in_comment d (LabelName.make_std name)
+    | Comment (`Docs d) -> any_in_comment d.elements (LabelName.make_std name)
     | _ -> None)
 
 let signature_in_sig sg name =
···
 
 let label_in_sig sg name =
   filter_in_sig sg (function
-    | Signature.Comment (`Docs d) -> any_in_comment d name
+    | Signature.Comment (`Docs d) -> any_in_comment d.elements name
     | _ -> None)
 
 let exception_in_sig sg name =

src/xref2/lang_of.ml

···
     Identifier.LabelParent.t ->
     Component.CComment.docs ->
     Odoc_model.Comment.docs =
- fun parent ds -> List.rev_map (fun d -> block_element parent d) ds |> List.rev
+ fun parent ds ->
+  {
+    elements =
+      List.rev_map (fun d -> block_element parent d) ds.elements |> List.rev;
+    suppress_warnings = ds.suppress_warnings;
+  }
 
 and docs_or_stop parent (d : Component.CComment.docs_or_stop) =
   match d with `Docs d -> `Docs (docs parent d) | `Stop -> `Stop

src/xref2/link.ml

···
   let map f = function Some x -> Some (f x) | None -> None
 end
 
+(* omg. Our current warning system is spread on different system. Hence this
+   atrocity. *)
+let maybe_suppress suppress_warnings =
+  if suppress_warnings then fun f ->
+    Lookup_failures.catch_failures ~filename:"" (fun () ->
+        Error.catch_warnings f |> fun x ->
+        Error.unpack_warnings x |> fst |> Error.unpack_warnings |> fst)
+    |> Error.unpack_warnings |> fst
+  else fun f -> f () |> Error.raise_warnings
+
 let source_loc env id loc =
   let id = (id :> Id.NonSrc.t) in
   match loc with Some _ as loc -> loc | None -> Shape_tools.lookup_def env id
 
 (** Equivalent to {!Comment.synopsis}. *)
 let synopsis_from_comment (docs : Component.CComment.docs) =
-  match docs with
+  match docs.elements with
   | ({ value = #Comment.nestable_block_element; _ } as e) :: _ ->
       (* Only the first element is considered. *)
       Comment.synopsis [ e ]
···
             p)
 
 let rec comment_inline_element :
-    loc:_ -> Env.t -> Comment.inline_element -> Comment.inline_element =
- fun ~loc:_ env x ->
+    loc:_ -> Env.t -> bool -> Comment.inline_element -> Comment.inline_element =
+ fun ~loc:_ env suppress_warnings x ->
   match x with
   | `Styled (s, ls) ->
-      `Styled (s, List.map (with_location (comment_inline_element env)) ls)
+      `Styled
+        ( s,
+          List.map
+            (with_location (comment_inline_element env suppress_warnings))
+            ls )
   | `Reference (r, content) as orig -> (
-      match Ref_tools.resolve_reference env r |> Error.raise_warnings with
+      match
+        maybe_suppress suppress_warnings (fun () ->
+            Ref_tools.resolve_reference env r)
+      with
       | Ok (ref_, c) ->
           let content =
             (* In case of labels, use the heading text as reference text if
···
           in
           `Reference (`Resolved ref_, content)
       | Error e ->
-          Errors.report ~what:(`Reference r) ~tools_error:(`Reference e)
-            `Resolve;
+          if not suppress_warnings then
+            Errors.report ~what:(`Reference r) ~tools_error:(`Reference e)
+              `Resolve;
           orig)
   | y -> y
 
-and paragraph env elts =
-  List.map (with_location (comment_inline_element env)) elts
+and paragraph env suppress_warnings elts =
+  List.map (with_location (comment_inline_element env suppress_warnings)) elts
 
-and resolve_external_synopsis env synopsis =
+and resolve_external_synopsis env suppress_warnings synopsis =
   let env = Env.inherit_resolver env in
-  paragraph env synopsis
+  paragraph env suppress_warnings synopsis
 
-and comment_nestable_block_element env parent ~loc:_
+and comment_nestable_block_element env suppress_warnings parent ~loc:_
     (x : Comment.nestable_block_element) =
   match x with
-  | `Paragraph elts -> `Paragraph (paragraph env elts)
+  | `Paragraph elts -> `Paragraph (paragraph env suppress_warnings elts)
   | (`Code_block _ | `Math_block _ | `Verbatim _) as x -> x
   | `List (x, ys) ->
       `List
         ( x,
-          List.rev_map (comment_nestable_block_element_list env parent) ys
+          List.rev_map
+            (comment_nestable_block_element_list env suppress_warnings parent)
+            ys
           |> List.rev )
   | `Table { data; align } ->
       let data =
         let map f x = List.rev_map f x |> List.rev in
         map
           (map (fun (cell, cell_type) ->
-               (comment_nestable_block_element_list env parent cell, cell_type)))
+               ( comment_nestable_block_element_list env suppress_warnings
+                   parent cell,
+                 cell_type )))
           data
       in
       `Table { Comment.data; align }
···
         List.rev_map
           (fun (r : Comment.module_reference) ->
             match
-              Ref_tools.resolve_module_reference env r.module_reference
-              |> Error.raise_warnings
+              maybe_suppress suppress_warnings (fun () ->
+                  Ref_tools.resolve_module_reference env r.module_reference)
             with
             | Ok (r, _, m) ->
                 let module_synopsis =
                   Opt.map
-                    (resolve_external_synopsis env)
+                    (resolve_external_synopsis env suppress_warnings)
                     (synopsis_of_module env m)
                 in
                 { Comment.module_reference = `Resolved r; module_synopsis }
             | Error e ->
-                Errors.report
-                  ~what:(`Reference (r.module_reference :> Paths.Reference.t))
-                  ~tools_error:(`Reference e) `Resolve;
+                if not suppress_warnings then
+                  Errors.report
+                    ~what:(`Reference (r.module_reference :> Paths.Reference.t))
+                    ~tools_error:(`Reference e) `Resolve;
                 r)
           refs
         |> List.rev
       in
       `Modules refs
   | `Media (`Reference r, m, content) as orig -> (
-      match Ref_tools.resolve_asset_reference env r |> Error.raise_warnings with
+      match
+        maybe_suppress suppress_warnings (fun () ->
+            Ref_tools.resolve_asset_reference env r)
+      with
       | Ok x -> `Media (`Reference (`Resolved x), m, content)
       | Error e ->
-          Errors.report
-            ~what:(`Reference (r :> Paths.Reference.t))
-            ~tools_error:(`Reference e) `Resolve;
+          if not suppress_warnings then
+            Errors.report
+              ~what:(`Reference (r :> Paths.Reference.t))
+              ~tools_error:(`Reference e) `Resolve;
           orig)
   | `Media _ as orig -> orig
 
-and comment_nestable_block_element_list env parent
+and comment_nestable_block_element_list env suppress_warnings parent
     (xs : Comment.nestable_block_element Comment.with_location list) =
-  List.rev_map (with_location (comment_nestable_block_element env parent)) xs
+  List.rev_map
+    (with_location
+       (comment_nestable_block_element env suppress_warnings parent))
+    xs
   |> List.rev
 
-and comment_tag env parent ~loc:_ (x : Comment.tag) =
+and comment_tag env suppress_warnings parent ~loc:_ (x : Comment.tag) =
   match x with
   | `Deprecated content ->
-      `Deprecated (comment_nestable_block_element_list env parent content)
+      `Deprecated
+        (comment_nestable_block_element_list env suppress_warnings parent
+           content)
   | `Param (name, content) ->
-      `Param (name, comment_nestable_block_element_list env parent content)
+      `Param
+        ( name,
+          comment_nestable_block_element_list env suppress_warnings parent
+            content )
   | `Raise ((`Reference (r, reference_content) as orig), content) -> (
-      match Ref_tools.resolve_reference env r |> Error.raise_warnings with
+      match
+        maybe_suppress suppress_warnings (fun () ->
+            Ref_tools.resolve_reference env r)
+      with
       | Ok (x, _) ->
           `Raise
             ( `Reference (`Resolved x, reference_content),
-              comment_nestable_block_element_list env parent content )
+              comment_nestable_block_element_list env suppress_warnings parent
+                content )
       | Error e ->
-          Errors.report ~what:(`Reference r) ~tools_error:(`Reference e)
-            `Resolve;
-          `Raise (orig, comment_nestable_block_element_list env parent content))
+          if not suppress_warnings then
+            Errors.report ~what:(`Reference r) ~tools_error:(`Reference e)
+              `Resolve;
+          `Raise
+            ( orig,
+              comment_nestable_block_element_list env suppress_warnings parent
+                content ))
   | `Raise ((`Code_span _ as orig), content) ->
-      `Raise (orig, comment_nestable_block_element_list env parent content)
+      `Raise
+        ( orig,
+          comment_nestable_block_element_list env suppress_warnings parent
+            content )
   | `Return content ->
-      `Return (comment_nestable_block_element_list env parent content)
+      `Return
+        (comment_nestable_block_element_list env suppress_warnings parent
+           content)
   | `See (kind, target, content) ->
-      `See (kind, target, comment_nestable_block_element_list env parent content)
+      `See
+        ( kind,
+          target,
+          comment_nestable_block_element_list env suppress_warnings parent
+            content )
   | `Before (version, content) ->
-      `Before (version, comment_nestable_block_element_list env parent content)
+      `Before
+        ( version,
+          comment_nestable_block_element_list env suppress_warnings parent
+            content )
   | `Author _ | `Since _ | `Alert _ | `Version _ ->
       x (* only contain primitives *)
 
-and comment_block_element env parent ~loc (x : Comment.block_element) =
+and comment_block_element env suppress_warnings parent ~loc
+    (x : Comment.block_element) =
   match x with
   | #Comment.nestable_block_element as x ->
-      (comment_nestable_block_element env parent ~loc x
+      (comment_nestable_block_element env suppress_warnings parent ~loc x
         :> Comment.block_element)
   | `Heading (attrs, label, elems) ->
-      let cie = comment_inline_element env in
+      let cie = comment_inline_element env suppress_warnings in
       let elems =
         List.rev_map (fun ele -> with_location cie ele) elems |> List.rev
       in
       let h = (attrs, label, elems) in
       check_ambiguous_label ~loc env h;
       `Heading h
-  | `Tag t -> `Tag (comment_tag env parent ~loc t)
+  | `Tag t -> `Tag (comment_tag env suppress_warnings parent ~loc t)
 
 and with_location :
     type a.
···
   { value; location = loc }
 
 and comment_docs env parent d =
-  List.rev_map
-    (with_location (comment_block_element env (parent :> Id.LabelParent.t)))
-    d
-  |> List.rev
+  {
+    Comment.elements =
+      List.rev_map
+        (with_location
+           (comment_block_element env d.Comment.suppress_warnings
+              (parent :> Id.LabelParent.t)))
+        d.Comment.elements
+      |> List.rev;
+    suppress_warnings = d.suppress_warnings;
+  }
 
 and comment env parent = function
   | `Stop -> `Stop

src/xref2/ref_tools.ml

···
           | _ -> find tl)
       | [] -> Error (`Find_by_name (`Page, name))
     in
-    find p.Odoc_model.Lang.Page.content
+    find p.Odoc_model.Lang.Page.content.elements
 
   let of_component _env ~parent_ref label =
     Ok

src/xref2/tools.ml

···
       let sg =
         (* Override the signature's documentation when the module also has
            a comment attached. *)
-        match m.doc with [] -> sg | doc -> { sg with doc }
+        match m.doc.elements with [] -> sg | _ -> { sg with doc = m.doc }
       in
       Ok (Signature sg)
   | Functor _ as f -> Ok f

test/frontmatter/frontmatter.t/run.t

···
     "toc_status": "None",
     "order_category": "None"
   }
-  $ odoc_print page-one_frontmatter.odoc | jq '.content'
+  $ odoc_print page-one_frontmatter.odoc | jq '.content.elements'
   [
     {
       "`Heading": [
···
     "toc_status": "None",
     "order_category": "None"
   }
-  $ odoc_print page-two_frontmatters.odoc | jq '.content'
+  $ odoc_print page-two_frontmatters.odoc | jq '.content.elements'
   [
     {
       "`Heading": [

test/integration/dune

···
+(env
+ (_
+  (binaries
+   (../odoc_print/odoc_print.exe as odoc_print))))
+
 (cram
  (deps
-  (package odoc)))
+  (package odoc)
+  %{bin:odoc_print}))
 
 (cram
  (applies_to json_expansion_with_sources)

test/integration/suppress_warnings.t/main.mli

···
+include Module_with_errors.S
+
+

test/integration/suppress_warnings.t/module_with_errors.mli

···
+module type S = sig
+  (** {1:t section} *)
+
+  type t
+
+  val here_is_the_problem : t
+  (** {!t} *)
+end
+

test/integration/suppress_warnings.t/run.t

···
+  $ ocamlc -c -bin-annot module_with_errors.mli
+  $ ocamlc -c -bin-annot main.mli
+
+  $ odoc compile module_with_errors.cmti
+  $ odoc compile main.cmti -I .
+  $ odoc link main.odoc
+  File "module_with_errors.mli", line 7, characters 6-10:
+  Warning: While resolving the expansion of include at File "main.mli", line 1, character 0
+  Reference to 't' is ambiguous. Please specify its kind: section-t, type-t.
+  $ odoc html-generate -o html main.odocl
+  $ odoc support-files -o html
+
+  $ odoc compile --suppress-warnings module_with_errors.cmti
+  $ odoc compile main.cmti -I .
+  $ odoc link main.odoc
+  $ odoc html-generate -o html2 main.odocl
+  $ odoc support-files -o html2
+
+
+

test/model/semantics/test.ml

···
     ( Error.unpack_warnings,
       Record
         [
-          F ("value", fst, Indirect (fst, Comment_desc.docs));
+          F ("value", fst, Indirect (fst, Comment_desc.elements));
           F ("warnings", snd, List warning_desc);
         ] )
 

test/pages/resolution.t/run.t

···
 references should be to the correct identifiers - so top1 should be a RootPage, sub1 is a Page, sub2 is a LeafPage, and m1 is a Root.
 
 This is the '{!childpage-sub1}' reference
-  $ odoc_print page-top1.odocl | jq '.content[1]["`Paragraph"][0]["`Reference"][0]'
+  $ odoc_print page-top1.odocl | jq '.content.elements[1]["`Paragraph"][0]["`Reference"][0]'
   {
     "`Resolved": {
       "`Identifier": {
···
   }
 
 This is the '{!childpage:sub2}' reference
-  $ odoc_print page-top1.odocl | jq '.content[1]["`Paragraph"][2]["`Reference"][0]'
+  $ odoc_print page-top1.odocl | jq '.content.elements[1]["`Paragraph"][2]["`Reference"][0]'
   {
     "`Resolved": {
       "`Identifier": {
···
   }
 
 This is the '{!childmodule:M1}' reference
-  $ odoc_print page-sub1.odocl | jq '.content[1]["`Paragraph"][0]["`Reference"][0]'
+  $ odoc_print page-sub1.odocl | jq '.content.elements[1]["`Paragraph"][0]["`Reference"][0]'
   {
     "`Resolved": {
       "`Identifier": {

test/xref2/canonical_nested.t/run.t

···
       ]
     },
     "source_loc": "None",
-    "doc": [],
+    "doc": {
+      "elements": [],
+      "suppress_warnings": "false"
+    },
     "type_": {
       "Alias": [
         {
···
       ]
     },
     "source_loc": "None",
-    "doc": [],
+    "doc": {
+      "elements": [],
+      "suppress_warnings": "false"
+    },
     "type_": {
       "Alias": [
         {
···
       ]
     },
     "source_loc": "None",
-    "doc": [],
+    "doc": {
+      "elements": [],
+      "suppress_warnings": "false"
+    },
     "type_": {
       "Alias": [
         {
···
                         ]
                       },
                       "source_loc": "None",
-                      "doc": [],
+                      "doc": {
+                        "elements": [],
+                        "suppress_warnings": "false"
+                      },
                       "equation": {
                         "params": [],
                         "private_": "false",
···
                 }
               ],
               "compiled": "true",
-              "doc": []
+              "doc": {
+                "elements": [],
+                "suppress_warnings": "false"
+              }
             }
           }
         }

test/xref2/classes.t/run.t

···
       ]
     },
     "source_loc": "None",
-    "doc": [],
+    "doc": {
+      "elements": [],
+      "suppress_warnings": "false"
+    },
     "type_": {
       "Class": [
         {
···
       ]
     },
     "source_loc": "None",
-    "doc": [],
+    "doc": {
+      "elements": [],
+      "suppress_warnings": "false"
+    },
     "type_": {
       "Class": [
         {

test/xref2/cross_references.t/run.t

···
 
 Check that references are resolved:
 
-  $ odoc_print a.odocl | jq '.content.Module.items[0].Type[1].doc[0]'
+  $ odoc_print a.odocl | jq '.content.Module.items[0].Type[1].doc.elements[0]'
   {
     "`Paragraph": [
       {
···
       }
     ]
   }
-  $ odoc_print b.odocl | jq '.content.Module.items[0].Type[1].doc[0]'
+  $ odoc_print b.odocl | jq '.content.Module.items[0].Type[1].doc.elements[0]'
   {
     "`Paragraph": [
       {

test/xref2/deep_substitution.t/run.t

···
       ]
     },
     "source_loc": "None",
-    "doc": [],
+    "doc": {
+      "elements": [],
+      "suppress_warnings": "false"
+    },
     "equation": {
       "params": [],
       "private_": "false",

test/xref2/hidden_modules.t/run.t

···
                   ]
                 },
                 "source_loc": "None",
-                "doc": [],
+                "doc": {
+                  "elements": [],
+                  "suppress_warnings": "false"
+                },
                 "equation": {
                   "params": [],
                   "private_": "false",
···
           }
         ],
         "compiled": "true",
-        "doc": []
+        "doc": {
+          "elements": [],
+          "suppress_warnings": "false"
+        }
       }
     }
   }
···
       ]
     },
     "source_loc": "None",
-    "doc": [],
+    "doc": { "elements": [], "suppress_warnings": "false" },
     "type_": {
       "Constr": [
         {

test/xref2/labels/page_labels.t/run.t

···
   $ odoc compile page.mld
   $ odoc link page-page.odoc
-  $ odoc_print page-page.odocl | jq '.content[1]["`Paragraph"][0]["`Reference"][0]'
+  $ odoc_print page-page.odocl | jq '.content.elements[1]["`Paragraph"][0]["`Reference"][0]'
   {
     "`Resolved": {
       "`Identifier": {

test/xref2/lib/common.cppo.ml

···
 
 let model_of_string str = 
     let cmti = cmti_of_string str in
-    Odoc_loader__Cmti.read_interface (Some parent) "Root" cmti
+    Odoc_loader__Cmti.read_interface (Some parent) "Root" false cmti
 
 let model_of_string_impl str =
 #if OCAML_VERSION < (4,13,0)
···
 #else
     let cmt = (cmt_of_string str).structure in
 #endif
-    Odoc_loader__Cmt.read_implementation (Some parent) "Root" cmt
+    Odoc_loader__Cmt.read_implementation (Some parent) "Root" false cmt
 
 let signature_of_mli_string str =
     Odoc_xref2.Ident.reset ();
···
     ) ~open_modules:[]
 
 let warnings_options =
-  { Odoc_model.Error.warn_error = false; print_warnings = true }
+  { Odoc_model.Error.warn_error = false; print_warnings = true; suppress_warnings = false }
 
 let handle_warnings ww =
   match Odoc_model.Error.handle_warnings ~warnings_options ww with

test/xref2/module_type_alias.t/run.t

···
   $ odoc_print test.odocl | jq ".content.Module.items[2]"
   {
     "Comment": {
-      "`Docs": [
-        {
-          "`Paragraph": [
-            {
-              "`Reference": [
-                {
-                  "`Resolved": {
-                    "`AliasModuleType": [
-                      {
-                        "`Identifier": {
-                          "`ModuleType": [
+      "`Docs": {
+        "elements": [
+          {
+            "`Paragraph": [
+              {
+                "`Reference": [
+                  {
+                    "`Resolved": {
+                      "`AliasModuleType": [
+                        {
+                          "`Identifier": {
+                            "`ModuleType": [
+                              {
+                                "`Root": [
+                                  "None",
+                                  "Test"
+                                ]
+                              },
+                              "A"
+                            ]
+                          }
+                        },
+                        {
+                          "`Identifier": {
+                            "`ModuleType": [
+                              {
+                                "`Root": [
+                                  "None",
+                                  "Test"
+                                ]
+                              },
+                              "B"
+                            ]
+                          }
+                        }
+                      ]
+                    }
+                  },
+                  []
+                ]
+              },
+              "`Space",
+              {
+                "`Reference": [
+                  {
+                    "`Resolved": {
+                      "`Type": [
+                        {
+                          "`AliasModuleType": [
                             {
-                              "`Root": [
-                                "None",
-                                "Test"
-                              ]
+                              "`Identifier": {
+                                "`ModuleType": [
+                                  {
+                                    "`Root": [
+                                      "None",
+                                      "Test"
+                                    ]
+                                  },
+                                  "A"
+                                ]
+                              }
                             },
-                            "A"
-                          ]
-                        }
-                      },
-                      {
-                        "`Identifier": {
-                          "`ModuleType": [
                             {
-                              "`Root": [
-                                "None",
-                                "Test"
-                              ]
-                            },
-                            "B"
+                              "`Identifier": {
+                                "`ModuleType": [
+                                  {
+                                    "`Root": [
+                                      "None",
+                                      "Test"
+                                    ]
+                                  },
+                                  "B"
+                                ]
+                              }
+                            }
                           ]
-                        }
-                      }
-                    ]
-                  }
-                },
-                []
-              ]
-            },
-            "`Space",
-            {
-              "`Reference": [
-                {
-                  "`Resolved": {
-                    "`Type": [
-                      {
-                        "`AliasModuleType": [
-                          {
-                            "`Identifier": {
-                              "`ModuleType": [
-                                {
-                                  "`Root": [
-                                    "None",
-                                    "Test"
-                                  ]
-                                },
-                                "A"
-                              ]
-                            }
-                          },
-                          {
-                            "`Identifier": {
-                              "`ModuleType": [
-                                {
-                                  "`Root": [
-                                    "None",
-                                    "Test"
-                                  ]
-                                },
-                                "B"
-                              ]
-                            }
-                          }
-                        ]
-                      },
-                      "t"
-                    ]
-                  }
-                },
-                []
-              ]
-            }
-          ]
-        }
-      ]
+                        },
+                        "t"
+                      ]
+                    }
+                  },
+                  []
+                ]
+              }
+            ]
+          }
+        ],
+        "suppress_warnings": "false"
+      }
     }
   }