diff --git a/src/document/generator.ml b/src/document/generator.ml index f23f087559..ac6a5913e0 100644 --- a/src/document/generator.ml +++ b/src/document/generator.ml @@ -1810,8 +1810,8 @@ module Make (Syntax : SYNTAX) = struct in let source_anchor = match t.source_info with - | Some { id; _ } -> Some (Source_page.url id) - | None -> None + | Some { id = Some id; _ } -> Some (Source_page.url id) + | _ -> None in let page = make_expansion_page ~source_anchor url [ unit_doc ] items in Document.Page page diff --git a/src/loader/implementation.ml b/src/loader/implementation.ml index efc47edcc0..756124ef9f 100644 --- a/src/loader/implementation.ml +++ b/src/loader/implementation.ml @@ -503,22 +503,30 @@ let of_cmt (source_id : Odoc_model.Paths.Identifier.SourcePage.t) (uid_to_id, postprocess_poses source_id vs uid_to_id uid_to_loc) -let read_cmt_infos source_id_opt id cmt_info = - let occ_infos = Occurrences.of_cmt cmt_info in +let read_cmt_infos source_id_opt id cmt_info ~count_occurrences = match Odoc_model.Compat.shape_of_cmt_infos cmt_info with | Some shape -> ( let uid_to_loc = cmt_info.cmt_uid_to_loc in - match (source_id_opt, cmt_info.cmt_annots) with - | Some source_id, Implementation impl -> + match (source_id_opt, count_occurrences, cmt_info.cmt_annots) with + | Some source_id, _, Implementation impl -> let map, source_infos = of_cmt source_id id impl uid_to_loc in + let occ_infos = Occurrences.of_cmt impl in let source_infos = List.rev_append source_infos occ_infos in ( Some (shape, map), Some { - Odoc_model.Lang.Source_info.id = source_id; + Odoc_model.Lang.Source_info.id = Some source_id; infos = source_infos; } ) - | _, _ -> (Some (shape, Odoc_model.Compat.empty_map), None)) + | None, true, Implementation impl -> + let occ_infos = Occurrences.of_cmt impl in + ( None, + Some + { + Odoc_model.Lang.Source_info.id = None; + infos = occ_infos; + } ) + | _, _, _ -> (Some (shape, Odoc_model.Compat.empty_map), None)) | None -> (None, None) diff --git a/src/loader/implementation.mli b/src/loader/implementation.mli index 49701e6dcc..88acd2030d 100644 --- a/src/loader/implementation.mli +++ b/src/loader/implementation.mli @@ -2,6 +2,7 @@ val read_cmt_infos : Odoc_model.Paths.Identifier.Id.source_page option -> Odoc_model.Paths.Identifier.Id.root_module -> Cmt_format.cmt_infos -> + count_occurrences:bool -> (Odoc_model.Compat.shape * Odoc_model.Paths.Identifier.Id.source_location Odoc_model.Compat.shape_uid_map) diff --git a/src/loader/occurrences.ml b/src/loader/occurrences.ml index 480a1f37ab..d039f9a35a 100644 --- a/src/loader/occurrences.ml +++ b/src/loader/occurrences.ml @@ -106,46 +106,42 @@ module Global_analysis = struct | _ -> () end -let of_cmt (cmt : Cmt_format.cmt_infos) = - let ttree = cmt.cmt_annots in - match ttree with - | Cmt_format.Implementation structure -> - let poses = ref [] in - let module_expr iterator mod_expr = - Global_analysis.module_expr poses mod_expr; - Compat.Tast_iterator.default_iterator.module_expr iterator mod_expr - in - let expr iterator e = - Global_analysis.expr poses e; - Compat.Tast_iterator.default_iterator.expr iterator e - in - let pat iterator e = - Global_analysis.pat poses e; - Compat.Tast_iterator.default_iterator.pat iterator e - in - let typ iterator ctyp_expr = - Global_analysis.core_type poses ctyp_expr; - Compat.Tast_iterator.default_iterator.typ iterator ctyp_expr - in - let module_type iterator mty = - Global_analysis.module_type poses mty; - Compat.Tast_iterator.default_iterator.module_type iterator mty - in - let class_type iterator cl_type = - Global_analysis.class_type poses cl_type; - Compat.Tast_iterator.default_iterator.class_type iterator cl_type - in - let iterator = - { - Compat.Tast_iterator.default_iterator with - expr; - pat; - module_expr; - typ; - module_type; - class_type; - } - in - iterator.structure iterator structure; - !poses - | _ -> [] +let of_cmt structure = + let poses = ref [] in + let module_expr iterator mod_expr = + Global_analysis.module_expr poses mod_expr; + Compat.Tast_iterator.default_iterator.module_expr iterator mod_expr + in + let expr iterator e = + Global_analysis.expr poses e; + Compat.Tast_iterator.default_iterator.expr iterator e + in + let pat iterator e = + Global_analysis.pat poses e; + Compat.Tast_iterator.default_iterator.pat iterator e + in + let typ iterator ctyp_expr = + Global_analysis.core_type poses ctyp_expr; + Compat.Tast_iterator.default_iterator.typ iterator ctyp_expr + in + let module_type iterator mty = + Global_analysis.module_type poses mty; + Compat.Tast_iterator.default_iterator.module_type iterator mty + in + let class_type iterator cl_type = + Global_analysis.class_type poses cl_type; + Compat.Tast_iterator.default_iterator.class_type iterator cl_type + in + let iterator = + { + Compat.Tast_iterator.default_iterator with + expr; + pat; + module_expr; + typ; + module_type; + class_type; + } + in + iterator.structure iterator structure; + !poses diff --git a/src/loader/odoc_loader.ml b/src/loader/odoc_loader.ml index a3f0cb8799..bdb3c177d0 100644 --- a/src/loader/odoc_loader.ml +++ b/src/loader/odoc_loader.ml @@ -42,12 +42,12 @@ exception Not_an_interface exception Make_root_error of string -let read_cmt_infos source_id_opt id ~filename () = +let read_cmt_infos source_id_opt id ~filename ~count_occurrences () = match Cmt_format.read_cmt filename with | exception Cmi_format.Error _ -> raise Corrupted | cmt_info -> ( match cmt_info.cmt_annots with - | Implementation _ -> Implementation.read_cmt_infos source_id_opt id cmt_info + | Implementation _ -> Implementation.read_cmt_infos source_id_opt id cmt_info ~count_occurrences | _ -> raise Not_an_implementation) @@ -99,7 +99,7 @@ let compilation_unit_of_sig ~make_root ~imports ~interface ?sourcefile ~name ~id make_compilation_unit ~make_root ~imports ~interface ?sourcefile ~name ~id ?canonical ?shape_info content -let read_cmti ~make_root ~parent ~filename ~cmt_filename_opt ~source_id_opt () = +let read_cmti ~make_root ~parent ~filename ~cmt_filename_opt ~source_id_opt ~count_occurrences () = let cmt_info = Cmt_format.read_cmt filename in match cmt_info.cmt_annots with | Interface intf -> ( @@ -116,15 +116,16 @@ let read_cmti ~make_root ~parent ~filename ~cmt_filename_opt ~source_id_opt () = let shape_info, source_info = match cmt_filename_opt with | Some cmt_filename -> - read_cmt_infos source_id_opt id ~filename:cmt_filename () - | None -> (None, None) + read_cmt_infos source_id_opt id ~filename:cmt_filename ~count_occurrences () + | None -> + (None, None) in compilation_unit_of_sig ~make_root ~imports:cmt_info.cmt_imports ~interface ~sourcefile ~name ~id ?shape_info ~source_info ?canonical sg) | _ -> raise Not_an_interface -let read_cmt ~make_root ~parent ~filename ~source_id_opt () = +let read_cmt ~make_root ~parent ~filename ~source_id_opt ~count_occurrences () = match Cmt_format.read_cmt filename with | exception Cmi_format.Error (Not_an_interface _) -> raise Not_an_implementation @@ -168,7 +169,7 @@ let read_cmt ~make_root ~parent ~filename ~source_id_opt () = | Implementation impl -> let id, sg, canonical = Cmt.read_implementation parent name impl in let shape_info, source_info = - read_cmt_infos source_id_opt id ~filename () + read_cmt_infos source_id_opt id ~filename ~count_occurrences () in compilation_unit_of_sig ~make_root ~imports ~interface ~sourcefile ~name ~id ?canonical ?shape_info ~source_info sg @@ -199,12 +200,12 @@ let wrap_errors ~filename f = | Not_an_interface -> not_an_interface filename | Make_root_error m -> error_msg filename m) -let read_cmti ~make_root ~parent ~filename ~source_id_opt ~cmt_filename_opt = +let read_cmti ~make_root ~parent ~filename ~source_id_opt ~cmt_filename_opt ~count_occurrences = wrap_errors ~filename - (read_cmti ~make_root ~parent ~filename ~source_id_opt ~cmt_filename_opt) + (read_cmti ~make_root ~parent ~filename ~source_id_opt ~cmt_filename_opt ~count_occurrences) -let read_cmt ~make_root ~parent ~filename ~source_id_opt = - wrap_errors ~filename (read_cmt ~make_root ~parent ~filename ~source_id_opt) +let read_cmt ~make_root ~parent ~filename ~source_id_opt ~count_occurrences = + wrap_errors ~filename (read_cmt ~make_root ~parent ~filename ~source_id_opt ~count_occurrences) let read_cmi ~make_root ~parent ~filename = wrap_errors ~filename (read_cmi ~make_root ~parent ~filename) diff --git a/src/loader/odoc_loader.mli b/src/loader/odoc_loader.mli index d60014f300..db0adc302d 100644 --- a/src/loader/odoc_loader.mli +++ b/src/loader/odoc_loader.mli @@ -19,6 +19,7 @@ val read_cmti : filename:string -> source_id_opt:Identifier.SourcePage.t option -> cmt_filename_opt:string option -> + count_occurrences:bool -> (Lang.Compilation_unit.t, Error.t) result Error.with_warnings val read_cmt : @@ -26,6 +27,7 @@ val read_cmt : parent:Identifier.ContainerPage.t option -> filename:string -> source_id_opt:Identifier.SourcePage.t option -> + count_occurrences:bool -> (Lang.Compilation_unit.t, Error.t) result Error.with_warnings val read_cmi : diff --git a/src/model/lang.ml b/src/model/lang.ml index 78b1272899..284b55dda7 100644 --- a/src/model/lang.ml +++ b/src/model/lang.ml @@ -32,7 +32,7 @@ module Source_info = struct type infos = annotation with_pos list - type t = { id : Identifier.SourcePage.t; infos : infos } + type t = { id : Identifier.SourcePage.t option; infos : infos } end module rec Module : sig diff --git a/src/model_desc/lang_desc.ml b/src/model_desc/lang_desc.ml index 56c96bc008..491fee961c 100644 --- a/src/model_desc/lang_desc.ml +++ b/src/model_desc/lang_desc.ml @@ -18,7 +18,7 @@ let inline_status = let source_info = let open Lang.Source_info in - Record [ F ("id", (fun t -> t.id), identifier) ] + Record [ F ("id", (fun t -> t.id), Option identifier) ] (** {3 Module} *) diff --git a/src/odoc/compile.ml b/src/odoc/compile.ml index e97ae2d817..51244fdf0a 100644 --- a/src/odoc/compile.ml +++ b/src/odoc/compile.ml @@ -99,16 +99,17 @@ let resolve_imports resolver imports = (** Raises warnings and errors. *) let resolve_and_substitute ~resolver ~make_root ~source_id_opt ~cmt_filename_opt ~hidden (parent : Paths.Identifier.ContainerPage.t option) input_file - input_type ~count_occurrences:_ = + input_type ~count_occurrences = let filename = Fs.File.to_string input_file in let unit = match input_type with | `Cmti -> Odoc_loader.read_cmti ~make_root ~parent ~filename ~source_id_opt - ~cmt_filename_opt + ~cmt_filename_opt ~count_occurrences |> Error.raise_errors_and_warnings | `Cmt -> Odoc_loader.read_cmt ~make_root ~parent ~filename ~source_id_opt + ~count_occurrences |> Error.raise_errors_and_warnings | `Cmi -> Odoc_loader.read_cmi ~make_root ~parent ~filename diff --git a/src/odoc/html_page.ml b/src/odoc/html_page.ml index b0c790416a..c316899694 100644 --- a/src/odoc/html_page.ml +++ b/src/odoc/html_page.ml @@ -39,7 +39,7 @@ let render { html_config; source = _; assets = _ } page = let source_documents source_info source ~syntax = match (source_info, source) with - | Some { Lang.Source_info.id; infos }, Some src -> ( + | Some { Lang.Source_info.id = Some id; infos }, Some src -> ( let file = match src with | Source.File f -> f @@ -68,7 +68,7 @@ let source_documents source_info source ~syntax = Odoc_document.Renderer.document_of_source ~syntax id syntax_info infos source_code; ]) - | Some { id; _ }, None -> + | Some { id = Some id; _ }, None -> let filename = Paths.Identifier.name id in Error.raise_warning (Error.filename_only @@ -77,14 +77,14 @@ let source_documents source_info source ~syntax = --source-name" filename); [] - | None, Some src -> + | _, Some src -> Error.raise_warning (Error.filename_only "--source argument is invalid on compilation unit that were not \ compiled with --source-parent and --source-name" (Source.to_string src)); [] - | None, None -> [] + | _, None -> [] let list_filter_map f lst = List.rev diff --git a/src/xref2/env.ml b/src/xref2/env.ml index 26f5ed7de6..dd4dbd842a 100644 --- a/src/xref2/env.ml +++ b/src/xref2/env.ml @@ -360,8 +360,8 @@ let module_of_unit : Lang.Compilation_unit.t -> Component.Module.t = let id = (unit.id :> Paths.Identifier.Module.t) in let locs = match unit.source_info with - | Some { id; _ } -> Some (Identifier.Mk.source_location_mod id) - | None -> None + | Some { id = Some id; _ } -> Some (Identifier.Mk.source_location_mod id) + | _ -> None in match unit.content with | Module s -> diff --git a/src/xref2/shape_tools.ml b/src/xref2/shape_tools.ml index 626816a56c..023d8fd19e 100644 --- a/src/xref2/shape_tools.ml +++ b/src/xref2/shape_tools.ml @@ -93,8 +93,8 @@ let lookup_shape : | Some x -> Some x | None -> ( match unit.source_info with - | Some si -> Some (MkId.source_location_mod si.id) - | None -> None) + | Some {id = Some id ; _} -> Some (MkId.source_location_mod id) + | _ -> None) let lookup_def : diff --git a/test/occurrences/double_wrapped.t/run.t b/test/occurrences/double_wrapped.t/run.t index 7c00f9928a..9041aed1ed 100644 --- a/test/occurrences/double_wrapped.t/run.t +++ b/test/occurrences/double_wrapped.t/run.t @@ -4,8 +4,6 @@ The module C is not exposed in the handwritten toplevel module. The module A and B are exposed. The module B depends on both B and C, the module C only depends on A. - $ odoc compile -c module-a -c src-source root.mld - $ ocamlc -c -o main__.cmo main__.ml -bin-annot -w -49 -no-alias-deps -I . $ ocamlc -c -open Main__ -o main__A.cmo a.ml -bin-annot -I . $ ocamlc -c -open Main__ -o main__C.cmo c.ml -bin-annot -I . @@ -15,15 +13,12 @@ The module B depends on both B and C, the module C only depends on A. Passing the count-occurrences flag to odoc compile makes it collect the occurrences information. - $ printf "a.ml\nb.ml\nc.ml\nmain.ml\n" > source_tree.map - $ odoc source-tree -I . --parent page-root -o src-source.odoc source_tree.map - - $ odoc compile --source-name a.ml --source-parent-file src-source.odoc --count-occurrences -I . main__A.cmt - $ odoc compile --source-name c.ml --source-parent-file src-source.odoc --count-occurrences -I . main__C.cmt - $ odoc compile --source-name b.ml --source-parent-file src-source.odoc --count-occurrences -I . main__B.cmt + $ odoc compile --count-occurrences -I . main__A.cmt + $ odoc compile --count-occurrences -I . main__C.cmt + $ odoc compile --count-occurrences -I . main__B.cmt $ odoc compile --count-occurrences -I . main__.cmt - $ odoc compile --source-name main.ml --source-parent-file src-source.odoc --count-occurrences -I . main.cmt + $ odoc compile --count-occurrences -I . main.cmt $ odoc link -I . main.odoc $ odoc link -I . main__A.odoc