Skip to content

Commit edefba2

Browse files
panglesdpanglesd
committed
Move occurrences to its own folder
Signed-off-by: Paul-Elliot <peada@free.fr>
1 parent 7a4468d commit edefba2

File tree

8 files changed

+145
-139
lines changed

8 files changed

+145
-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: 24 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,24 @@
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+
unit.Implementation.source_info
20+
21+
let aggregate ~tbl ~data =
22+
Table.iter
23+
(fun id { Table.direct; _ } -> Table.add ~quantity:direct tbl id)
24+
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 -> Implementation.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
@@ -34,130 +34,10 @@ let fold_dirs ~dirs ~f ~init =
3434
acc dir)
3535
(Ok init)
3636

37-
module H = Hashtbl.Make (Odoc_model.Paths.Identifier)
38-
39-
module Occtbl : sig
40-
type item = { direct : int; indirect : int; sub : item H.t }
41-
type t = item H.t
42-
type key = Odoc_model.Paths.Identifier.t
43-
val v : unit -> t
44-
45-
val add : t -> key -> unit
46-
47-
val iter : (key -> item -> unit) -> t -> unit
48-
49-
val get : t -> key -> item option
50-
end = struct
51-
type item = { direct : int; indirect : int; sub : item H.t }
52-
type t = item H.t
53-
type key = Odoc_model.Paths.Identifier.t
54-
55-
let v_item () = { direct = 0; indirect = 0; sub = H.create 0 }
56-
57-
let v () = H.create 0
58-
59-
let add tbl id =
60-
let rec add ?(kind = `Indirect) id =
61-
let incr htbl id =
62-
let { direct; indirect; sub } =
63-
try H.find htbl id with Not_found -> v_item ()
64-
in
65-
let direct, indirect =
66-
match kind with
67-
| `Direct -> (direct + 1, indirect)
68-
| `Indirect -> (direct, indirect + 1)
69-
in
70-
H.replace htbl id { direct; indirect; sub };
71-
sub
72-
in
73-
let do_ parent =
74-
let htbl = add (parent :> key) in
75-
incr htbl id
76-
in
77-
match id.iv with
78-
| `InstanceVariable (parent, _) -> do_ parent
79-
| `Parameter (parent, _) -> do_ parent
80-
| `Module (parent, _) -> do_ parent
81-
| `ModuleType (parent, _) -> do_ parent
82-
| `Method (parent, _) -> do_ parent
83-
| `Field (parent, _) -> do_ parent
84-
| `Extension (parent, _) -> do_ parent
85-
| `Type (parent, _) -> do_ parent
86-
| `CoreType _ -> incr tbl id
87-
| `Constructor (parent, _) -> do_ parent
88-
| `Exception (parent, _) -> do_ parent
89-
| `ExtensionDecl (parent, _, _) -> do_ parent
90-
| `Class (parent, _) -> do_ parent
91-
| `Value (parent, _) -> do_ parent
92-
| `ClassType (parent, _) -> do_ parent
93-
| `Root _ -> incr tbl id
94-
| `SourcePage _ | `Page _ | `LeafPage _ | `SourceLocation _
95-
| `CoreException _ | `Label _ | `SourceLocationMod _ | `Result _
96-
| `AssetFile _ | `SourceDir _ | `SourceLocationInternal _ ->
97-
assert false
98-
in
99-
let _htbl = add ~kind:`Direct id in
100-
()
101-
102-
let rec get t id =
103-
let do_ parent =
104-
get t (parent :> key) |> function
105-
| None -> None
106-
| Some { sub; _ } -> ( try Some (H.find sub id) with Not_found -> None)
107-
in
108-
match id.iv with
109-
| `InstanceVariable (parent, _) -> do_ parent
110-
| `Parameter (parent, _) -> do_ parent
111-
| `Module (parent, _) -> do_ parent
112-
| `ModuleType (parent, _) -> do_ parent
113-
| `Method (parent, _) -> do_ parent
114-
| `Field (parent, _) -> do_ parent
115-
| `Extension (parent, _) -> do_ parent
116-
| `ExtensionDecl (parent, _, _) -> do_ parent
117-
| `Type (parent, _) -> do_ parent
118-
| `Constructor (parent, _) -> do_ parent
119-
| `Exception (parent, _) -> do_ parent
120-
| `Class (parent, _) -> do_ parent
121-
| `Value (parent, _) -> do_ parent
122-
| `ClassType (parent, _) -> do_ parent
123-
| `Root _ -> ( try Some (H.find t id) with Not_found -> None)
124-
| `SourcePage _ | `Page _ | `LeafPage _ | `CoreType _ | `SourceLocation _
125-
| `CoreException _ | `Label _ | `SourceLocationMod _ | `Result _
126-
| `AssetFile _ | `SourceDir _ | `SourceLocationInternal _ ->
127-
assert false
128-
129-
let rec iter f tbl =
130-
H.iter
131-
(fun id v ->
132-
iter f v.sub;
133-
f id v)
134-
tbl
135-
end
136-
13737
let count ~dst ~warnings_options:_ directories include_hidden =
138-
let htbl = H.create 100 in
38+
let htbl = Odoc_occurrences.Table.v () in
13939
let f () (unit : Odoc_model.Lang.Implementation.t) =
140-
let incr tbl p =
141-
let p = (p :> Odoc_model.Paths.Path.Resolved.t) in
142-
let id = Odoc_model.Paths.Path.Resolved.identifier p in
143-
if (not (Odoc_model.Paths.Path.Resolved.is_hidden p)) || include_hidden
144-
then Occtbl.add tbl id
145-
in
146-
let () =
147-
List.iter
148-
(function
149-
| ( Odoc_model.Lang.Source_info.Module
150-
{ documentation = Some (`Resolved p); _ },
151-
_ ) ->
152-
incr htbl p
153-
| Value { documentation = Some (`Resolved p); _ }, _ -> incr htbl p
154-
| ModuleType { documentation = Some (`Resolved p); _ }, _ ->
155-
incr htbl p
156-
| Type { documentation = Some (`Resolved p); _ }, _ -> incr htbl p
157-
| _ -> ())
158-
unit.source_info
159-
in
160-
()
40+
Odoc_occurrences.of_impl ~include_hidden unit htbl
16141
in
16242
fold_dirs ~dirs:directories ~f ~init:() >>= fun () ->
16343
Fs.Directory.mkdir_p (Fs.File.dirname dst);
@@ -188,27 +68,18 @@ let aggregate files file_list ~warnings_options:_ ~dst =
18868
try
18969
parse_input_files file_list >>= fun new_files ->
19070
let files = files @ new_files in
191-
let from_file file : Occtbl.t =
71+
let from_file file : Odoc_occurrences.Table.t =
19272
let ic = open_in_bin (Fs.File.to_string file) in
19373
Marshal.from_channel ic
19474
in
195-
let rec loop n f =
196-
if n > 0 then (
197-
f ();
198-
loop (n - 1) f)
199-
else ()
200-
in
20175
let occtbl =
20276
match files with
203-
| [] -> H.create 0
204-
| file1 :: files ->
205-
let acc = from_file file1 in
77+
| [] -> Odoc_occurrences.Table.v ()
78+
| file :: files ->
79+
let acc = from_file file in
20680
List.iter
20781
(fun file ->
208-
Occtbl.iter
209-
(fun id { direct; _ } ->
210-
loop direct (fun () -> Occtbl.add acc id))
211-
(from_file file))
82+
Odoc_occurrences.aggregate ~tbl:acc ~data:(from_file file))
21283
files;
21384
acc
21485
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)