From a5447e0054e010acbbcb9aba025c147a7a0f95cc Mon Sep 17 00:00:00 2001 From: Paul-Elliot Date: Wed, 31 Jan 2024 10:44:18 +0100 Subject: [PATCH] Move occurrences to its own folder Signed-off-by: Paul-Elliot --- src/occurrences/dune | 4 + src/occurrences/odoc_occurrences.ml | 26 +++++ src/occurrences/odoc_occurrences.mli | 9 ++ src/occurrences/table.ml | 86 ++++++++++++++++ src/occurrences/table.mli | 11 +++ src/odoc/dune | 1 + src/odoc/occurrences.ml | 143 ++------------------------- test/odoc_print/occurrences_print.ml | 6 +- 8 files changed, 147 insertions(+), 139 deletions(-) create mode 100644 src/occurrences/dune create mode 100644 src/occurrences/odoc_occurrences.ml create mode 100644 src/occurrences/odoc_occurrences.mli create mode 100644 src/occurrences/table.ml create mode 100644 src/occurrences/table.mli diff --git a/src/occurrences/dune b/src/occurrences/dune new file mode 100644 index 0000000000..8cf8ce1920 --- /dev/null +++ b/src/occurrences/dune @@ -0,0 +1,4 @@ +(library + (name odoc_occurrences) + (public_name odoc.occurrences) + (libraries odoc_model)) diff --git a/src/occurrences/odoc_occurrences.ml b/src/occurrences/odoc_occurrences.ml new file mode 100644 index 0000000000..69ad453b4d --- /dev/null +++ b/src/occurrences/odoc_occurrences.ml @@ -0,0 +1,26 @@ +module Table = Table + +let of_impl ~include_hidden unit htbl = + let incr tbl p = + let open Odoc_model.Paths.Path.Resolved in + let p = (p :> t) in + let id = identifier p in + if (not (is_hidden p)) || include_hidden then Table.add tbl id + in + let open Odoc_model.Lang in + List.iter + (function + | Source_info.Module { documentation = Some (`Resolved p); _ }, _ -> + incr htbl p + | Value { documentation = Some (`Resolved p); _ }, _ -> incr htbl p + | ModuleType { documentation = Some (`Resolved p); _ }, _ -> incr htbl p + | Type { documentation = Some (`Resolved p); _ }, _ -> incr htbl p + | _ -> ()) + (match unit.Compilation_unit.source_info with + | None -> [] + | Some i -> i.infos) + +let aggregate ~tbl ~data = + Table.iter + (fun id { Table.direct; _ } -> Table.add ~quantity:direct tbl id) + data diff --git a/src/occurrences/odoc_occurrences.mli b/src/occurrences/odoc_occurrences.mli new file mode 100644 index 0000000000..f393225512 --- /dev/null +++ b/src/occurrences/odoc_occurrences.mli @@ -0,0 +1,9 @@ +open Odoc_model.Lang + +module Table = Table + +val of_impl : include_hidden:bool -> Compilation_unit.t -> Table.t -> unit +(** Add all occurrences from implementation of a compilation unit into a table *) + +val aggregate : tbl:Table.t -> data:Table.t -> unit +(** Aggregate [data] into [tbl] *) diff --git a/src/occurrences/table.ml b/src/occurrences/table.ml new file mode 100644 index 0000000000..90edba008e --- /dev/null +++ b/src/occurrences/table.ml @@ -0,0 +1,86 @@ +module H = Hashtbl.Make (Odoc_model.Paths.Identifier) + +type t = item H.t +and item = { direct : int; indirect : int; sub : item H.t } +type key = Odoc_model.Paths.Identifier.t + +let v_item () = { direct = 0; indirect = 0; sub = H.create 0 } + +let v () = H.create 0 + +let add ?(quantity = 1) tbl id = + let rec add ?(kind = `Indirect) id = + let incr htbl id = + let { direct; indirect; sub } = + try H.find htbl id with Not_found -> v_item () + in + let direct, indirect = + match kind with + | `Direct -> (direct + quantity, indirect) + | `Indirect -> (direct, indirect + quantity) + in + H.replace htbl id { direct; indirect; sub }; + sub + in + let do_ parent = + let htbl = add (parent :> key) in + incr htbl id + in + match id.iv with + | `InstanceVariable (parent, _) -> do_ parent + | `Parameter (parent, _) -> do_ parent + | `Module (parent, _) -> do_ parent + | `ModuleType (parent, _) -> do_ parent + | `Method (parent, _) -> do_ parent + | `Field (parent, _) -> do_ parent + | `Extension (parent, _) -> do_ parent + | `Type (parent, _) -> do_ parent + | `CoreType _ -> incr tbl id + | `Constructor (parent, _) -> do_ parent + | `Exception (parent, _) -> do_ parent + | `ExtensionDecl (parent, _, _) -> do_ parent + | `Class (parent, _) -> do_ parent + | `Value (parent, _) -> do_ parent + | `ClassType (parent, _) -> do_ parent + | `Root _ -> incr tbl id + | `SourcePage _ | `Page _ | `LeafPage _ | `SourceLocation _ + | `CoreException _ | `Label _ | `SourceLocationMod _ | `Result _ + | `AssetFile _ | `SourceDir _ | `SourceLocationInternal _ -> + assert false + in + let _htbl = add ~kind:`Direct id in + () + +let rec get t id = + let do_ parent = + get t (parent :> key) |> function + | None -> None + | Some { sub; _ } -> ( try Some (H.find sub id) with Not_found -> None) + in + match id.iv with + | `InstanceVariable (parent, _) -> do_ parent + | `Parameter (parent, _) -> do_ parent + | `Module (parent, _) -> do_ parent + | `ModuleType (parent, _) -> do_ parent + | `Method (parent, _) -> do_ parent + | `Field (parent, _) -> do_ parent + | `Extension (parent, _) -> do_ parent + | `ExtensionDecl (parent, _, _) -> do_ parent + | `Type (parent, _) -> do_ parent + | `Constructor (parent, _) -> do_ parent + | `Exception (parent, _) -> do_ parent + | `Class (parent, _) -> do_ parent + | `Value (parent, _) -> do_ parent + | `ClassType (parent, _) -> do_ parent + | `Root _ -> ( try Some (H.find t id) with Not_found -> None) + | `SourcePage _ | `Page _ | `LeafPage _ | `CoreType _ | `SourceLocation _ + | `CoreException _ | `Label _ | `SourceLocationMod _ | `Result _ + | `AssetFile _ | `SourceDir _ | `SourceLocationInternal _ -> + assert false + +let rec iter f tbl = + H.iter + (fun id v -> + iter f v.sub; + f id v) + tbl diff --git a/src/occurrences/table.mli b/src/occurrences/table.mli new file mode 100644 index 0000000000..9c36a16a0d --- /dev/null +++ b/src/occurrences/table.mli @@ -0,0 +1,11 @@ +type t +type item = { direct : int; indirect : int; sub : t } +type key = Odoc_model.Paths.Identifier.t + +val v : unit -> t + +val add : ?quantity:int -> t -> key -> unit + +val iter : (key -> item -> unit) -> t -> unit + +val get : t -> key -> item option diff --git a/src/odoc/dune b/src/odoc/dune index d7c04fa956..02bc8e4d11 100644 --- a/src/odoc/dune +++ b/src/odoc/dune @@ -12,6 +12,7 @@ odoc_model odoc_json_index odoc_xref2 + odoc_occurrences tyxml unix) (instrumentation diff --git a/src/odoc/occurrences.ml b/src/odoc/occurrences.ml index 04ef7c53ae..2634155538 100644 --- a/src/odoc/occurrences.ml +++ b/src/odoc/occurrences.ml @@ -21,130 +21,10 @@ let fold_dirs ~dirs ~f ~init = acc dir) (Ok init) -module H = Hashtbl.Make (Odoc_model.Paths.Identifier) - -module Occtbl : sig - type item = { direct : int; indirect : int; sub : item H.t } - type t = item H.t - type key = Odoc_model.Paths.Identifier.t - val v : unit -> t - - val add : t -> key -> unit - - val iter : (key -> item -> unit) -> t -> unit - - val get : t -> key -> item option -end = struct - type item = { direct : int; indirect : int; sub : item H.t } - type t = item H.t - type key = Odoc_model.Paths.Identifier.t - - let v_item () = { direct = 0; indirect = 0; sub = H.create 0 } - - let v () = H.create 0 - - let add tbl id = - let rec add ?(kind = `Indirect) id = - let incr htbl id = - let { direct; indirect; sub } = - try H.find htbl id with Not_found -> v_item () - in - let direct, indirect = - match kind with - | `Direct -> (direct + 1, indirect) - | `Indirect -> (direct, indirect + 1) - in - H.replace htbl id { direct; indirect; sub }; - sub - in - let do_ parent = - let htbl = add (parent :> key) in - incr htbl id - in - match id.iv with - | `InstanceVariable (parent, _) -> do_ parent - | `Parameter (parent, _) -> do_ parent - | `Module (parent, _) -> do_ parent - | `ModuleType (parent, _) -> do_ parent - | `Method (parent, _) -> do_ parent - | `Field (parent, _) -> do_ parent - | `Extension (parent, _) -> do_ parent - | `Type (parent, _) -> do_ parent - | `CoreType _ -> incr tbl id - | `Constructor (parent, _) -> do_ parent - | `Exception (parent, _) -> do_ parent - | `ExtensionDecl (parent, _, _) -> do_ parent - | `Class (parent, _) -> do_ parent - | `Value (parent, _) -> do_ parent - | `ClassType (parent, _) -> do_ parent - | `Root _ -> incr tbl id - | `SourcePage _ | `Page _ | `LeafPage _ | `SourceLocation _ - | `CoreException _ | `Label _ | `SourceLocationMod _ | `Result _ - | `AssetFile _ | `SourceDir _ | `SourceLocationInternal _ -> - assert false - in - let _htbl = add ~kind:`Direct id in - () - - let rec get t id = - let do_ parent = - get t (parent :> key) |> function - | None -> None - | Some { sub; _ } -> ( try Some (H.find sub id) with Not_found -> None) - in - match id.iv with - | `InstanceVariable (parent, _) -> do_ parent - | `Parameter (parent, _) -> do_ parent - | `Module (parent, _) -> do_ parent - | `ModuleType (parent, _) -> do_ parent - | `Method (parent, _) -> do_ parent - | `Field (parent, _) -> do_ parent - | `Extension (parent, _) -> do_ parent - | `ExtensionDecl (parent, _, _) -> do_ parent - | `Type (parent, _) -> do_ parent - | `Constructor (parent, _) -> do_ parent - | `Exception (parent, _) -> do_ parent - | `Class (parent, _) -> do_ parent - | `Value (parent, _) -> do_ parent - | `ClassType (parent, _) -> do_ parent - | `Root _ -> ( try Some (H.find t id) with Not_found -> None) - | `SourcePage _ | `Page _ | `LeafPage _ | `CoreType _ | `SourceLocation _ - | `CoreException _ | `Label _ | `SourceLocationMod _ | `Result _ - | `AssetFile _ | `SourceDir _ | `SourceLocationInternal _ -> - assert false - - let rec iter f tbl = - H.iter - (fun id v -> - iter f v.sub; - f id v) - tbl -end - let count ~dst ~warnings_options:_ directories include_hidden = - let htbl = H.create 100 in + let htbl = Odoc_occurrences.Table.v () in let f () (unit : Odoc_model.Lang.Compilation_unit.t) = - let incr tbl p = - let p = (p :> Odoc_model.Paths.Path.Resolved.t) in - let id = Odoc_model.Paths.Path.Resolved.identifier p in - if (not (Odoc_model.Paths.Path.Resolved.is_hidden p)) || include_hidden - then Occtbl.add tbl id - in - let () = - List.iter - (function - | ( Odoc_model.Lang.Source_info.Module - { documentation = Some (`Resolved p); _ }, - _ ) -> - incr htbl p - | Value { documentation = Some (`Resolved p); _ }, _ -> incr htbl p - | ModuleType { documentation = Some (`Resolved p); _ }, _ -> - incr htbl p - | Type { documentation = Some (`Resolved p); _ }, _ -> incr htbl p - | _ -> ()) - (match unit.source_info with None -> [] | Some i -> i.infos) - in - () + Odoc_occurrences.of_impl ~include_hidden unit htbl in fold_dirs ~dirs:directories ~f ~init:() >>= fun () -> Fs.Directory.mkdir_p (Fs.File.dirname dst); @@ -175,27 +55,18 @@ let aggregate files file_list ~warnings_options:_ ~dst = try parse_input_files file_list >>= fun new_files -> let files = files @ new_files in - let from_file file : Occtbl.t = + let from_file file : Odoc_occurrences.Table.t = let ic = open_in_bin (Fs.File.to_string file) in Marshal.from_channel ic in - let rec loop n f = - if n > 0 then ( - f (); - loop (n - 1) f) - else () - in let occtbl = match files with - | [] -> H.create 0 - | file1 :: files -> - let acc = from_file file1 in + | [] -> Odoc_occurrences.Table.v () + | file :: files -> + let acc = from_file file in List.iter (fun file -> - Occtbl.iter - (fun id { direct; _ } -> - loop direct (fun () -> Occtbl.add acc id)) - (from_file file)) + Odoc_occurrences.aggregate ~tbl:acc ~data:(from_file file)) files; acc in diff --git a/test/odoc_print/occurrences_print.ml b/test/odoc_print/occurrences_print.ml index eb2f8c4284..b8adaea436 100644 --- a/test/odoc_print/occurrences_print.ml +++ b/test/odoc_print/occurrences_print.ml @@ -2,9 +2,9 @@ module H = Hashtbl.Make (Odoc_model.Paths.Identifier) let run inp = let ic = open_in_bin inp in - let htbl : Odoc_odoc.Occurrences.Occtbl.t = Marshal.from_channel ic in - Odoc_odoc.Occurrences.Occtbl.iter - (fun id { Odoc_odoc.Occurrences.Occtbl.direct; indirect; _ } -> + let htbl : Odoc_occurrences.Table.t = Marshal.from_channel ic in + Odoc_occurrences.Table.iter + (fun id { Odoc_occurrences.Table.direct; indirect; _ } -> let id = String.concat "." (Odoc_model.Paths.Identifier.fullname id) in Format.printf "%s was used directly %d times and indirectly %d times\n" id direct indirect)