Skip to content

Commit a65f359

Browse files
jonludlamjonludlam
committed
Add the ability to strip paths when aggregating occurrence info
This allow the aggregator to discard info about different versions when aggregating usage counts. For example, if you have two occurrence files that happen to have been built against different versions of the compiler which both reference 'Stdlib.List' twice, without this flag you would have two different references in the occurrence table: /path/to/first/compiler/Stdlib.List: 2 /path/to/second/compiler/Stdlib.List: 2 With this flag, the output would be: Stdlib.List: 4
1 parent 77b5700 commit a65f359

File tree

4 files changed

+94
-6
lines changed

4 files changed

+94
-6
lines changed

‎src/occurrences/table.ml

Lines changed: 75 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -92,3 +92,78 @@ let rec iter f tbl =
9292
let v = internal_to_item v in
9393
f id v)
9494
tbl
95+
96+
module Strip = struct
97+
open Odoc_model.Paths.Identifier
98+
let rec strip_sig_path : Signature.t -> Signature.t =
99+
fun x ->
100+
match x.iv with
101+
| `Root (_, name) -> Mk.root (None, name)
102+
| `Module (p, name) -> Mk.module_ (strip_sig_path p, name)
103+
| `Parameter (p, name) -> Mk.parameter (strip_sig_path p, name)
104+
| `Result p -> Mk.result (strip_sig_path p)
105+
| `ModuleType (p, name) -> Mk.module_type (strip_sig_path p, name)
106+
107+
and strip_class_sig_path : ClassSignature.t -> ClassSignature.t =
108+
fun x ->
109+
match x.iv with
110+
| `Class (p, name) -> Mk.class_ (strip_sig_path p, name)
111+
| `ClassType (p, name) -> Mk.class_type (strip_sig_path p, name)
112+
113+
and strip_datatype_path : DataType.t -> DataType.t =
114+
fun x ->
115+
match x.iv with `Type (p, name) -> Mk.type_ (strip_sig_path p, name)
116+
117+
and strip_field_parent_path : FieldParent.t -> FieldParent.t =
118+
fun x ->
119+
match x with
120+
| { iv = #Signature.t_pv; _ } as v -> (strip_sig_path v :> FieldParent.t)
121+
| { iv = #DataType.t_pv; _ } as v ->
122+
(strip_datatype_path v :> FieldParent.t)
123+
124+
and strip_label_parent_path : LabelParent.t -> LabelParent.t =
125+
fun x ->
126+
match x with
127+
| { iv = #Signature.t_pv; _ } as v -> (strip_sig_path v :> LabelParent.t)
128+
| { iv = #DataType.t_pv; _ } as v ->
129+
(strip_datatype_path v :> LabelParent.t)
130+
| { iv = #ClassSignature.t_pv; _ } as v ->
131+
(strip_class_sig_path v :> LabelParent.t)
132+
| { iv = `Page _ | `LeafPage _; _ } -> x
133+
134+
and strip : t -> t =
135+
fun x ->
136+
match x with
137+
| { iv = #Signature.t_pv; _ } as v -> (strip_sig_path v :> t)
138+
| { iv = #ClassSignature.t_pv; _ } as v -> (strip_class_sig_path v :> t)
139+
| { iv = #DataType.t_pv; _ } as v -> (strip_datatype_path v :> t)
140+
| { iv = `InstanceVariable (p, name); _ } ->
141+
Mk.instance_variable (strip_class_sig_path p, name)
142+
| { iv = `Method (p, name); _ } -> Mk.method_ (strip_class_sig_path p, name)
143+
| { iv = `Field (p, name); _ } -> Mk.field (strip_field_parent_path p, name)
144+
| { iv = `Label (p, name); _ } -> Mk.label (strip_label_parent_path p, name)
145+
| { iv = `Exception (p, name); _ } -> Mk.exception_ (strip_sig_path p, name)
146+
| { iv = `Extension (p, name); _ } -> Mk.extension (strip_sig_path p, name)
147+
| { iv = `Value (p, name); _ } -> Mk.value (strip_sig_path p, name)
148+
| { iv = `ExtensionDecl (p, name, args); _ } ->
149+
Mk.extension_decl (strip_sig_path p, (name, args))
150+
| { iv = `Constructor (p, name); _ } ->
151+
Mk.constructor (strip_datatype_path p, name)
152+
| {
153+
iv =
154+
( `AssetFile (_, _)
155+
| `SourceLocationMod _ | `SourceLocation _ | `Page _ | `LeafPage _
156+
| `SourcePage _ | `SourceLocationInternal _ );
157+
_;
158+
} ->
159+
x
160+
161+
let rec strip_table tbl =
162+
let t2 = v () in
163+
H.iter
164+
(fun key v -> H.add t2 (strip key) { v with sub = strip_table v.sub })
165+
tbl;
166+
t2
167+
end
168+
169+
let strip_table = Strip.strip_table

‎src/occurrences/table.mli

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -9,3 +9,5 @@ val add : ?quantity:int -> t -> key -> unit
99
val iter : (key -> item -> unit) -> t -> unit
1010

1111
val get : t -> key -> item option
12+
13+
val strip_table : t -> t

‎src/odoc/bin/main.ml

Lines changed: 9 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1626,7 +1626,7 @@ module Occurrences = struct
16261626
Cmd.info "count-occurrences" ~docs ~doc
16271627
end
16281628
module Aggregate = struct
1629-
let index dst files file_list warnings_options =
1629+
let index dst files file_list strip_path warnings_options =
16301630
match (files, file_list) with
16311631
| [], [] ->
16321632
Error
@@ -1635,7 +1635,8 @@ module Occurrences = struct
16351635
to odoc aggregate-occurrences")
16361636
| _ ->
16371637
dst_of_string dst >>= fun dst ->
1638-
Occurrences.aggregate ~dst ~warnings_options files file_list
1638+
Occurrences.aggregate ~dst ~warnings_options ~strip_path files
1639+
file_list
16391640

16401641
let cmd =
16411642
let dst =
@@ -1658,9 +1659,14 @@ module Occurrences = struct
16581659
let doc = "file created with count-occurrences" in
16591660
Arg.(value & pos_all convert_fpath [] & info ~doc ~docv:"FILE" [])
16601661
in
1662+
let strip_path =
1663+
let doc = "Strip package/version information from paths" in
1664+
Arg.(value & flag & info ~doc [ "strip-path" ])
1665+
in
16611666
Term.(
16621667
const handle_error
1663-
$ (const index $ dst $ inputs $ inputs_in_file $ warnings_options))
1668+
$ (const index $ dst $ inputs $ inputs_in_file $ strip_path
1669+
$ warnings_options))
16641670

16651671
let info ~docs =
16661672
let doc = "Aggregate hashtables created with odoc count-occurrences." in

‎src/odoc/occurrences.ml

Lines changed: 8 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -53,18 +53,23 @@ let parse_input_files input =
5353
let read_occurrences file : Odoc_occurrences.Table.t =
5454
Io_utils.unmarshal (Fpath.to_string file)
5555

56-
let aggregate files file_list ~warnings_options:_ ~dst =
56+
let aggregate files file_list ~strip_path ~warnings_options:_ ~dst =
5757
try
5858
parse_input_files file_list >>= fun new_files ->
5959
let files = files @ new_files in
6060
let occtbl =
6161
match files with
6262
| [] -> Odoc_occurrences.Table.v ()
6363
| file :: files ->
64-
let acc = read_occurrences file in
64+
let strip =
65+
if strip_path then Odoc_occurrences.Table.strip_table else Fun.id
66+
in
67+
let acc = read_occurrences file |> strip in
68+
6569
List.iter
6670
(fun file ->
67-
Odoc_occurrences.aggregate ~tbl:acc ~data:(read_occurrences file))
71+
Odoc_occurrences.aggregate ~tbl:acc
72+
~data:(read_occurrences file |> strip))
6873
files;
6974
acc
7075
in

0 commit comments

Comments
 (0)