Skip to content

Commit cb51bef

Browse files
panglesdpanglesd
committed
Move occurrences to its own folder
Signed-off-by: Paul-Elliot <[email protected]>
1 parent 0bbf974 commit cb51bef

File tree

8 files changed

+147
-139
lines changed

8 files changed

+147
-139
lines changed

‎src/occurrences/dune‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,4 @@
1+
(library
2+
(name odoc_occurrences)
3+
(public_name odoc.occurrences)
4+
(libraries odoc_model))

‎src/occurrences/odoc_occurrences.ml‎

Lines changed: 26 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,26 @@
1+
module Table = Table
2+
3+
let of_impl ~include_hidden unit htbl =
4+
let incr tbl p =
5+
let open Odoc_model.Paths.Path.Resolved in
6+
let p = (p :> t) in
7+
let id = identifier p in
8+
if (not (is_hidden p)) || include_hidden then Table.add tbl id
9+
in
10+
let open Odoc_model.Lang in
11+
List.iter
12+
(function
13+
| Source_info.Module { documentation = Some (`Resolved p); _ }, _ ->
14+
incr htbl p
15+
| Value { documentation = Some (`Resolved p); _ }, _ -> incr htbl p
16+
| ModuleType { documentation = Some (`Resolved p); _ }, _ -> incr htbl p
17+
| Type { documentation = Some (`Resolved p); _ }, _ -> incr htbl p
18+
| _ -> ())
19+
(match unit.Compilation_unit.source_info with
20+
| None -> []
21+
| Some i -> i.infos)
22+
23+
let aggregate ~tbl ~data =
24+
Table.iter
25+
(fun id { Table.direct; _ } -> Table.add ~quantity:direct tbl id)
26+
data

‎src/occurrences/odoc_occurrences.mli‎

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,9 @@
1+
open Odoc_model.Lang
2+
3+
module Table = Table
4+
5+
val of_impl : include_hidden:bool -> Compilation_unit.t -> Table.t -> unit
6+
(** Add all occurrences from implementation of a compilation unit into a table *)
7+
8+
val aggregate : tbl:Table.t -> data:Table.t -> unit
9+
(** Aggregate [data] into [tbl] *)

‎src/occurrences/table.ml‎

Lines changed: 86 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,86 @@
1+
module H = Hashtbl.Make (Odoc_model.Paths.Identifier)
2+
3+
type t = item H.t
4+
and item = { direct : int; indirect : int; sub : item H.t }
5+
type key = Odoc_model.Paths.Identifier.t
6+
7+
let v_item () = { direct = 0; indirect = 0; sub = H.create 0 }
8+
9+
let v () = H.create 0
10+
11+
let add ?(quantity = 1) tbl id =
12+
let rec add ?(kind = `Indirect) id =
13+
let incr htbl id =
14+
let { direct; indirect; sub } =
15+
try H.find htbl id with Not_found -> v_item ()
16+
in
17+
let direct, indirect =
18+
match kind with
19+
| `Direct -> (direct + quantity, indirect)
20+
| `Indirect -> (direct, indirect + quantity)
21+
in
22+
H.replace htbl id { direct; indirect; sub };
23+
sub
24+
in
25+
let do_ parent =
26+
let htbl = add (parent :> key) in
27+
incr htbl id
28+
in
29+
match id.iv with
30+
| `InstanceVariable (parent, _) -> do_ parent
31+
| `Parameter (parent, _) -> do_ parent
32+
| `Module (parent, _) -> do_ parent
33+
| `ModuleType (parent, _) -> do_ parent
34+
| `Method (parent, _) -> do_ parent
35+
| `Field (parent, _) -> do_ parent
36+
| `Extension (parent, _) -> do_ parent
37+
| `Type (parent, _) -> do_ parent
38+
| `CoreType _ -> incr tbl id
39+
| `Constructor (parent, _) -> do_ parent
40+
| `Exception (parent, _) -> do_ parent
41+
| `ExtensionDecl (parent, _, _) -> do_ parent
42+
| `Class (parent, _) -> do_ parent
43+
| `Value (parent, _) -> do_ parent
44+
| `ClassType (parent, _) -> do_ parent
45+
| `Root _ -> incr tbl id
46+
| `SourcePage _ | `Page _ | `LeafPage _ | `SourceLocation _
47+
| `CoreException _ | `Label _ | `SourceLocationMod _ | `Result _
48+
| `AssetFile _ | `SourceDir _ | `SourceLocationInternal _ ->
49+
assert false
50+
in
51+
let _htbl = add ~kind:`Direct id in
52+
()
53+
54+
let rec get t id =
55+
let do_ parent =
56+
get t (parent :> key) |> function
57+
| None -> None
58+
| Some { sub; _ } -> ( try Some (H.find sub id) with Not_found -> None)
59+
in
60+
match id.iv with
61+
| `InstanceVariable (parent, _) -> do_ parent
62+
| `Parameter (parent, _) -> do_ parent
63+
| `Module (parent, _) -> do_ parent
64+
| `ModuleType (parent, _) -> do_ parent
65+
| `Method (parent, _) -> do_ parent
66+
| `Field (parent, _) -> do_ parent
67+
| `Extension (parent, _) -> do_ parent
68+
| `ExtensionDecl (parent, _, _) -> do_ parent
69+
| `Type (parent, _) -> do_ parent
70+
| `Constructor (parent, _) -> do_ parent
71+
| `Exception (parent, _) -> do_ parent
72+
| `Class (parent, _) -> do_ parent
73+
| `Value (parent, _) -> do_ parent
74+
| `ClassType (parent, _) -> do_ parent
75+
| `Root _ -> ( try Some (H.find t id) with Not_found -> None)
76+
| `SourcePage _ | `Page _ | `LeafPage _ | `CoreType _ | `SourceLocation _
77+
| `CoreException _ | `Label _ | `SourceLocationMod _ | `Result _
78+
| `AssetFile _ | `SourceDir _ | `SourceLocationInternal _ ->
79+
assert false
80+
81+
let rec iter f tbl =
82+
H.iter
83+
(fun id v ->
84+
iter f v.sub;
85+
f id v)
86+
tbl

‎src/occurrences/table.mli‎

Lines changed: 11 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,11 @@
1+
type t
2+
type item = { direct : int; indirect : int; sub : t }
3+
type key = Odoc_model.Paths.Identifier.t
4+
5+
val v : unit -> t
6+
7+
val add : ?quantity:int -> t -> key -> unit
8+
9+
val iter : (key -> item -> unit) -> t -> unit
10+
11+
val get : t -> key -> item option

‎src/odoc/dune‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -12,6 +12,7 @@
1212
odoc_model
1313
odoc_json_index
1414
odoc_xref2
15+
odoc_occurrences
1516
tyxml
1617
unix)
1718
(instrumentation

‎src/odoc/occurrences.ml‎

Lines changed: 7 additions & 136 deletions
Original file line numberDiff line numberDiff line change
@@ -21,130 +21,10 @@ let fold_dirs ~dirs ~f ~init =
2121
acc dir)
2222
(Ok init)
2323

24-
module H = Hashtbl.Make (Odoc_model.Paths.Identifier)
25-
26-
module Occtbl : sig
27-
type item = { direct : int; indirect : int; sub : item H.t }
28-
type t = item H.t
29-
type key = Odoc_model.Paths.Identifier.t
30-
val v : unit -> t
31-
32-
val add : t -> key -> unit
33-
34-
val iter : (key -> item -> unit) -> t -> unit
35-
36-
val get : t -> key -> item option
37-
end = struct
38-
type item = { direct : int; indirect : int; sub : item H.t }
39-
type t = item H.t
40-
type key = Odoc_model.Paths.Identifier.t
41-
42-
let v_item () = { direct = 0; indirect = 0; sub = H.create 0 }
43-
44-
let v () = H.create 0
45-
46-
let add tbl id =
47-
let rec add ?(kind = `Indirect) id =
48-
let incr htbl id =
49-
let { direct; indirect; sub } =
50-
try H.find htbl id with Not_found -> v_item ()
51-
in
52-
let direct, indirect =
53-
match kind with
54-
| `Direct -> (direct + 1, indirect)
55-
| `Indirect -> (direct, indirect + 1)
56-
in
57-
H.replace htbl id { direct; indirect; sub };
58-
sub
59-
in
60-
let do_ parent =
61-
let htbl = add (parent :> key) in
62-
incr htbl id
63-
in
64-
match id.iv with
65-
| `InstanceVariable (parent, _) -> do_ parent
66-
| `Parameter (parent, _) -> do_ parent
67-
| `Module (parent, _) -> do_ parent
68-
| `ModuleType (parent, _) -> do_ parent
69-
| `Method (parent, _) -> do_ parent
70-
| `Field (parent, _) -> do_ parent
71-
| `Extension (parent, _) -> do_ parent
72-
| `Type (parent, _) -> do_ parent
73-
| `CoreType _ -> incr tbl id
74-
| `Constructor (parent, _) -> do_ parent
75-
| `Exception (parent, _) -> do_ parent
76-
| `ExtensionDecl (parent, _, _) -> do_ parent
77-
| `Class (parent, _) -> do_ parent
78-
| `Value (parent, _) -> do_ parent
79-
| `ClassType (parent, _) -> do_ parent
80-
| `Root _ -> incr tbl id
81-
| `SourcePage _ | `Page _ | `LeafPage _ | `SourceLocation _
82-
| `CoreException _ | `Label _ | `SourceLocationMod _ | `Result _
83-
| `AssetFile _ | `SourceDir _ | `SourceLocationInternal _ ->
84-
assert false
85-
in
86-
let _htbl = add ~kind:`Direct id in
87-
()
88-
89-
let rec get t id =
90-
let do_ parent =
91-
get t (parent :> key) |> function
92-
| None -> None
93-
| Some { sub; _ } -> ( try Some (H.find sub id) with Not_found -> None)
94-
in
95-
match id.iv with
96-
| `InstanceVariable (parent, _) -> do_ parent
97-
| `Parameter (parent, _) -> do_ parent
98-
| `Module (parent, _) -> do_ parent
99-
| `ModuleType (parent, _) -> do_ parent
100-
| `Method (parent, _) -> do_ parent
101-
| `Field (parent, _) -> do_ parent
102-
| `Extension (parent, _) -> do_ parent
103-
| `ExtensionDecl (parent, _, _) -> do_ parent
104-
| `Type (parent, _) -> do_ parent
105-
| `Constructor (parent, _) -> do_ parent
106-
| `Exception (parent, _) -> do_ parent
107-
| `Class (parent, _) -> do_ parent
108-
| `Value (parent, _) -> do_ parent
109-
| `ClassType (parent, _) -> do_ parent
110-
| `Root _ -> ( try Some (H.find t id) with Not_found -> None)
111-
| `SourcePage _ | `Page _ | `LeafPage _ | `CoreType _ | `SourceLocation _
112-
| `CoreException _ | `Label _ | `SourceLocationMod _ | `Result _
113-
| `AssetFile _ | `SourceDir _ | `SourceLocationInternal _ ->
114-
assert false
115-
116-
let rec iter f tbl =
117-
H.iter
118-
(fun id v ->
119-
iter f v.sub;
120-
f id v)
121-
tbl
122-
end
123-
12424
let count ~dst ~warnings_options:_ directories include_hidden =
125-
let htbl = H.create 100 in
25+
let htbl = Odoc_occurrences.Table.v () in
12626
let f () (unit : Odoc_model.Lang.Compilation_unit.t) =
127-
let incr tbl p =
128-
let p = (p :> Odoc_model.Paths.Path.Resolved.t) in
129-
let id = Odoc_model.Paths.Path.Resolved.identifier p in
130-
if (not (Odoc_model.Paths.Path.Resolved.is_hidden p)) || include_hidden
131-
then Occtbl.add tbl id
132-
in
133-
let () =
134-
List.iter
135-
(function
136-
| ( Odoc_model.Lang.Source_info.Module
137-
{ documentation = Some (`Resolved p); _ },
138-
_ ) ->
139-
incr htbl p
140-
| Value { documentation = Some (`Resolved p); _ }, _ -> incr htbl p
141-
| ModuleType { documentation = Some (`Resolved p); _ }, _ ->
142-
incr htbl p
143-
| Type { documentation = Some (`Resolved p); _ }, _ -> incr htbl p
144-
| _ -> ())
145-
(match unit.source_info with None -> [] | Some i -> i.infos)
146-
in
147-
()
27+
Odoc_occurrences.of_impl ~include_hidden unit htbl
14828
in
14929
fold_dirs ~dirs:directories ~f ~init:() >>= fun () ->
15030
Fs.Directory.mkdir_p (Fs.File.dirname dst);
@@ -175,27 +55,18 @@ let aggregate files file_list ~warnings_options:_ ~dst =
17555
try
17656
parse_input_files file_list >>= fun new_files ->
17757
let files = files @ new_files in
178-
let from_file file : Occtbl.t =
58+
let from_file file : Odoc_occurrences.Table.t =
17959
let ic = open_in_bin (Fs.File.to_string file) in
18060
Marshal.from_channel ic
18161
in
182-
let rec loop n f =
183-
if n > 0 then (
184-
f ();
185-
loop (n - 1) f)
186-
else ()
187-
in
18862
let occtbl =
18963
match files with
190-
| [] -> H.create 0
191-
| file1 :: files ->
192-
let acc = from_file file1 in
64+
| [] -> Odoc_occurrences.Table.v ()
65+
| file :: files ->
66+
let acc = from_file file in
19367
List.iter
19468
(fun file ->
195-
Occtbl.iter
196-
(fun id { direct; _ } ->
197-
loop direct (fun () -> Occtbl.add acc id))
198-
(from_file file))
69+
Odoc_occurrences.aggregate ~tbl:acc ~data:(from_file file))
19970
files;
20071
acc
20172
in

‎test/odoc_print/occurrences_print.ml‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -2,9 +2,9 @@ module H = Hashtbl.Make (Odoc_model.Paths.Identifier)
22

33
let run inp =
44
let ic = open_in_bin inp in
5-
let htbl : Odoc_odoc.Occurrences.Occtbl.t = Marshal.from_channel ic in
6-
Odoc_odoc.Occurrences.Occtbl.iter
7-
(fun id { Odoc_odoc.Occurrences.Occtbl.direct; indirect; _ } ->
5+
let htbl : Odoc_occurrences.Table.t = Marshal.from_channel ic in
6+
Odoc_occurrences.Table.iter
7+
(fun id { Odoc_occurrences.Table.direct; indirect; _ } ->
88
let id = String.concat "." (Odoc_model.Paths.Identifier.fullname id) in
99
Format.printf "%s was used directly %d times and indirectly %d times\n" id
1010
direct indirect)

0 commit comments

Comments
 (0)