jon.recoil.org
this repo has no description
Move occurrences to its own folder
Signed-off-by: Paul-Elliot <peada@free.fr>
+4
src/occurrences/dune
+4
src/occurrences/dune
+24
src/occurrences/odoc_occurrences.ml
+24
src/occurrences/odoc_occurrences.ml
···
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
+9
src/occurrences/odoc_occurrences.mli
+9
src/occurrences/odoc_occurrences.mli
···
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] *)
+86
src/occurrences/table.ml
+86
src/occurrences/table.ml
···
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
+11
src/occurrences/table.mli
+11
src/occurrences/table.mli
+1
src/odoc/dune
+1
src/odoc/dune
+7
-136
src/odoc/occurrences.ml
+7
-136
src/odoc/occurrences.ml
···
34
34
acc dir)
35
35
(Ok init)
36
36
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
-
137
37
let count ~dst ~warnings_options:_ directories include_hidden =
138
-
let htbl = H.create 100 in
38
+
let htbl = Odoc_occurrences.Table.v () in
139
39
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
161
41
in
162
42
fold_dirs ~dirs:directories ~f ~init:() >>= fun () ->
163
43
Fs.Directory.mkdir_p (Fs.File.dirname dst);
···
188
68
try
189
69
parse_input_files file_list >>= fun new_files ->
190
70
let files = files @ new_files in
191
-
let from_file file : Occtbl.t =
71
+
let from_file file : Odoc_occurrences.Table.t =
192
72
let ic = open_in_bin (Fs.File.to_string file) in
193
73
Marshal.from_channel ic
194
74
in
195
-
let rec loop n f =
196
-
if n > 0 then (
197
-
f ();
198
-
loop (n - 1) f)
199
-
else ()
200
-
in
201
75
let occtbl =
202
76
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
206
80
List.iter
207
81
(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))
212
83
files;
213
84
acc
214
85
in
+3
-3
test/odoc_print/occurrences_print.ml
+3
-3
test/odoc_print/occurrences_print.ml
···
2
2
3
3
let run inp =
4
4
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; _ } ->
8
8
let id = String.concat "." (Odoc_model.Paths.Identifier.fullname id) in
9
9
Format.printf "%s was used directly %d times and indirectly %d times\n" id
10
10
direct indirect)