Skip to content

Commit df131f3

Browse files
mununkimununki
committed
Add value binding analysis feature to dependency graph
- Introduced `-vb` and `--value-binding` command-line options to analyze usage count of a value binding in dependents of a specified module. - Implemented `count_value_usage_in_dependents` function in `dependency_graph.ml` to count occurrences of a value binding. - Enhanced output formatting in `formatter.ml` to support value usage representation in both DOT and JSON formats. - Updated `main.ml` to handle new command-line options and integrate value binding analysis into the existing workflow.
1 parent adf3c4e commit df131f3

20 files changed

Lines changed: 523 additions & 26 deletions

‎bin/main.ml‎

Lines changed: 40 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -9,6 +9,7 @@ let benchmark = ref false
99
let skip_cache = ref false
1010
let clear_cache = ref false
1111
let no_dependents = ref false
12+
let value_binding = ref None
1213

1314
let spec_list =
1415
[
@@ -58,6 +59,14 @@ let spec_list =
5859
( "-nd",
5960
Arg.Set no_dependents,
6061
"Output modules with no dependents (short for --no-dependents)" );
62+
( "-vb",
63+
Arg.String (fun s -> value_binding := Some s),
64+
"Analyze usage count of a value binding in dependents of the focused \
65+
module" );
66+
( "--value-binding",
67+
Arg.String (fun s -> value_binding := Some s),
68+
"Analyze usage count of a value binding in dependents of the focused \
69+
module" );
6170
]
6271

6372
let anon_fun file = input_files := file :: !input_files
@@ -113,7 +122,36 @@ let main () =
113122

114123
time_checkpoint "Graph building completed";
115124

116-
(* Apply module focus if specified or filter standard modules *)
125+
(* 3: If both -m and -vb are specified, only output value usage count *)
126+
(match (!focus_module, !value_binding) with
127+
| Some module_name, Some value_name ->
128+
let normalized_name =
129+
Rescriptdep.Parse_utils.normalize_module_name module_name
130+
in
131+
let focused_graph =
132+
Rescriptdep.Dependency_graph.create_focused_graph graph
133+
normalized_name
134+
in
135+
time_checkpoint "Module focusing completed";
136+
let usage_list =
137+
Rescriptdep.Dependency_graph.count_value_usage_in_dependents
138+
focused_graph ~module_name:normalized_name ~value_name
139+
in
140+
let output_to =
141+
match !output_file with
142+
| Some file -> Some (open_out file)
143+
| None -> None
144+
in
145+
(match output_to with
146+
| Some ch ->
147+
Rescriptdep.Formatter.output_value_usage !format usage_list ch;
148+
close_out ch
149+
| None ->
150+
Rescriptdep.Formatter.output_value_usage !format usage_list stdout);
151+
exit 0
152+
| _ -> ());
153+
154+
(* 1,2: Graph output branch *)
117155
let focused_graph =
118156
match !focus_module with
119157
| Some module_name ->
@@ -127,7 +165,7 @@ let main () =
127165
time_checkpoint "Module focusing completed";
128166
result
129167
| None ->
130-
(* When no focus module is specified, filter out standard modules *)
168+
(* If no focus module is specified, filter out standard modules *)
131169
let filtered_graph =
132170
Rescriptdep.Dependency_graph.create_filtered_graph graph
133171
in
@@ -175,7 +213,6 @@ let main () =
175213
if !benchmark then (
176214
let total_time = Unix.gettimeofday () -. start_time in
177215
Printf.eprintf "[BENCH] Total execution time: %.4f seconds\n" total_time;
178-
179216
exit 0)
180217
with
181218
| Rescriptdep.Parser.Invalid_cmt_file msg ->

‎lib/dependency_graph.ml‎

Lines changed: 213 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -335,3 +335,216 @@ let create_focused_graph graph center_module =
335335
let find_modules_with_no_dependents graph =
336336
let modules = get_modules graph in
337337
List.filter (fun m -> find_dependents graph m = []) modules
338+
339+
(* Count value usage in dependents of a module *)
340+
let count_value_usage_in_dependents graph ~module_name ~value_name =
341+
let open Stdlib in
342+
let open Cmt_format in
343+
let dependents = find_dependents graph module_name in
344+
let find_cmt_path file_path =
345+
let cmt_path =
346+
Parser.DependencyExtractor.get_cmt_path_for_source file_path
347+
in
348+
if Sys.file_exists cmt_path then Some cmt_path else None
349+
in
350+
let rec get_head_module_name path =
351+
match path with
352+
| Path.Pident id -> Ident.name id
353+
| Path.Pdot (p, _, _) -> get_head_module_name p
354+
| _ -> Path.name path
355+
in
356+
let rec count_in_expression value_name module_name open_modules current_module
357+
expr =
358+
match expr.Typedtree.exp_desc with
359+
| Typedtree.Texp_ident (path, _, _) -> (
360+
match path with
361+
| Path.Pident id ->
362+
if
363+
Ident.name id = value_name
364+
&& (List.mem module_name open_modules
365+
|| current_module = module_name)
366+
then 1
367+
else 0
368+
| Path.Pdot (p, id, _) ->
369+
if id = value_name && get_head_module_name p = module_name then 1
370+
else 0
371+
| _ -> 0)
372+
| Typedtree.Texp_let (_, vbs, e) ->
373+
List.fold_left
374+
(fun acc vb ->
375+
acc
376+
+ count_in_expression value_name module_name open_modules
377+
current_module vb.Typedtree.vb_expr)
378+
(count_in_expression value_name module_name open_modules
379+
current_module e)
380+
vbs
381+
| Typedtree.Texp_function { cases; _ } ->
382+
List.fold_left
383+
(fun acc c ->
384+
acc
385+
+ count_in_expression value_name module_name open_modules
386+
current_module c.Typedtree.c_rhs)
387+
0 cases
388+
| Typedtree.Texp_apply (e, args) ->
389+
List.fold_left
390+
(fun acc (_, eo) ->
391+
acc
392+
+
393+
match eo with
394+
| Some e ->
395+
count_in_expression value_name module_name open_modules
396+
current_module e
397+
| None -> 0)
398+
(count_in_expression value_name module_name open_modules
399+
current_module e)
400+
args
401+
| Typedtree.Texp_match (e, cases, cases2, _) ->
402+
count_in_expression value_name module_name open_modules current_module e
403+
+ List.fold_left
404+
(fun acc c ->
405+
acc
406+
+ count_in_expression value_name module_name open_modules
407+
current_module c.Typedtree.c_rhs)
408+
0 (cases @ cases2)
409+
| Typedtree.Texp_tuple elist | Typedtree.Texp_array elist ->
410+
List.fold_left
411+
(fun acc e ->
412+
acc
413+
+ count_in_expression value_name module_name open_modules
414+
current_module e)
415+
0 elist
416+
| Typedtree.Texp_construct (_, _, elist) ->
417+
List.fold_left
418+
(fun acc e ->
419+
acc
420+
+ count_in_expression value_name module_name open_modules
421+
current_module e)
422+
0 elist
423+
| Typedtree.Texp_variant (_, eo) -> (
424+
match eo with
425+
| Some e ->
426+
count_in_expression value_name module_name open_modules
427+
current_module e
428+
| None -> 0)
429+
| Typedtree.Texp_record { fields; extended_expression; _ } -> (
430+
let acc =
431+
Array.fold_left
432+
(fun acc (_, fld) ->
433+
match fld with
434+
| Typedtree.Overridden (_, e) ->
435+
acc
436+
+ count_in_expression value_name module_name open_modules
437+
current_module e
438+
| Typedtree.Kept _ -> acc)
439+
0 fields
440+
in
441+
match extended_expression with
442+
| Some e ->
443+
acc
444+
+ count_in_expression value_name module_name open_modules
445+
current_module e
446+
| None -> acc)
447+
| Typedtree.Texp_field (e, _, _) ->
448+
count_in_expression value_name module_name open_modules current_module e
449+
| Typedtree.Texp_setfield (e1, _, _, e2) ->
450+
count_in_expression value_name module_name open_modules current_module
451+
e1
452+
+ count_in_expression value_name module_name open_modules current_module
453+
e2
454+
| Typedtree.Texp_ifthenelse (e1, e2, eo) -> (
455+
count_in_expression value_name module_name open_modules current_module
456+
e1
457+
+ count_in_expression value_name module_name open_modules current_module
458+
e2
459+
+
460+
match eo with
461+
| Some e ->
462+
count_in_expression value_name module_name open_modules
463+
current_module e
464+
| None -> 0)
465+
| Typedtree.Texp_sequence (e1, e2) ->
466+
count_in_expression value_name module_name open_modules current_module
467+
e1
468+
+ count_in_expression value_name module_name open_modules current_module
469+
e2
470+
| Typedtree.Texp_while (e1, e2) ->
471+
count_in_expression value_name module_name open_modules current_module
472+
e1
473+
+ count_in_expression value_name module_name open_modules current_module
474+
e2
475+
| Typedtree.Texp_for (_, _, e1, e2, _, e3) ->
476+
count_in_expression value_name module_name open_modules current_module
477+
e1
478+
+ count_in_expression value_name module_name open_modules current_module
479+
e2
480+
+ count_in_expression value_name module_name open_modules current_module
481+
e3
482+
| Typedtree.Texp_send (e, _, eo) -> (
483+
count_in_expression value_name module_name open_modules current_module e
484+
+
485+
match eo with
486+
| Some e ->
487+
count_in_expression value_name module_name open_modules
488+
current_module e
489+
| None -> 0)
490+
| Typedtree.Texp_open (open_decl, e) ->
491+
let open_mod =
492+
match open_decl.open_expr.mod_desc with
493+
| Typedtree.Tmod_ident (path, _) -> Path.name path
494+
| _ -> ""
495+
in
496+
count_in_expression value_name module_name (open_mod :: open_modules)
497+
current_module e
498+
| _ -> 0
499+
in
500+
let rec count_in_structure value_name module_name current_module structure =
501+
List.fold_left
502+
(fun acc item ->
503+
match item.Typedtree.str_desc with
504+
| Typedtree.Tstr_value (_, vbs) ->
505+
acc
506+
+ List.fold_left
507+
(fun acc vb ->
508+
acc
509+
+ count_in_expression value_name module_name [] current_module
510+
vb.Typedtree.vb_expr)
511+
0 vbs
512+
| Typedtree.Tstr_eval (e, _) ->
513+
acc + count_in_expression value_name module_name [] current_module e
514+
| Typedtree.Tstr_module { mb_expr = { mod_desc; _ }; _ } -> (
515+
match mod_desc with
516+
| Typedtree.Tmod_structure s ->
517+
acc + count_in_structure value_name module_name current_module s
518+
| Typedtree.Tmod_constraint (mexpr, _, _, _) -> (
519+
match mexpr.mod_desc with
520+
| Typedtree.Tmod_structure s ->
521+
acc
522+
+ count_in_structure value_name module_name current_module s
523+
| _ -> acc)
524+
| _ -> acc)
525+
| _ -> acc)
526+
0 structure.Typedtree.str_items
527+
in
528+
List.map
529+
(fun dep ->
530+
let file_path_opt = get_module_path graph dep in
531+
if Option.is_some file_path_opt then
532+
let file_path = Option.get file_path_opt in
533+
let cmt_path_opt = find_cmt_path file_path in
534+
if Option.is_some cmt_path_opt then
535+
let cmt_path = Option.get cmt_path_opt in
536+
try
537+
let cmt_info = Cmt_format.read_cmt cmt_path in
538+
match cmt_info.cmt_annots with
539+
| Implementation structure ->
540+
let count =
541+
count_in_structure value_name module_name dep structure
542+
in
543+
(dep, count)
544+
| _ -> (dep, -2)
545+
(* -2: No implementation AST *)
546+
with _ -> (dep, -3) (* -3: CMT read error *)
547+
else (dep, -4) (* -4: No .cmt file found *)
548+
else (dep, -5)
549+
(* -5: No file path found *))
550+
dependents

‎lib/formatter.ml‎

Lines changed: 26 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -454,3 +454,29 @@ let all_formats = [ Dot; Json ]
454454

455455
(* Get the default format *)
456456
let default_format = Dot
457+
458+
let output_value_usage_dot usage_list out_channel =
459+
output_string out_channel "digraph {\n";
460+
List.iter
461+
(fun (name, count) ->
462+
Printf.fprintf out_channel " \"%s\" [label=\"%s\\ncount: %d\"]\n" name
463+
name count)
464+
usage_list;
465+
output_string out_channel "}\n"
466+
467+
let output_value_usage_json usage_list out_channel =
468+
output_string out_channel "{\n";
469+
output_string out_channel " \"modules\": [\n";
470+
List.iteri
471+
(fun i (name, count) ->
472+
Printf.fprintf out_channel " { \"name\": \"%s\", \"count\": %d }%s\n"
473+
name count
474+
(if i = List.length usage_list - 1 then "" else ","))
475+
usage_list;
476+
output_string out_channel " ]\n";
477+
output_string out_channel "}\n"
478+
479+
let output_value_usage format usage_list out_channel =
480+
match format with
481+
| Dot -> output_value_usage_dot usage_list out_channel
482+
| Json -> output_value_usage_json usage_list out_channel

‎lib/parser.ml‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -235,7 +235,7 @@ module DependencyExtractor = struct
235235
match path with
236236
| Path.Pident id ->
237237
(* In our simplified Path module, Pident only contains a string *)
238-
id
238+
Ident.name id
239239
| Path.Pdot (_, s, _) ->
240240
(* For Pdot, extract just the name part *)
241241
s

‎test/rescript/src/app.bs.js‎

Lines changed: 12 additions & 1 deletion
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎test/rescript/src/app.res‎

Lines changed: 6 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,11 @@
1+
module M = {
2+
@react.component
3+
let make = (~p as _) => <Comp0 />
4+
}
5+
16
let run = () => {
27
let result = Math.square(5)
38
Logger.log(`Result: ${result->Belt.Int.toString}`)
49

5-
<Comp0 />
10+
<M p=10 />
611
}

‎test/rescript/src/math.bs.js‎

Lines changed: 9 additions & 0 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎test/rescript/src/math.res‎

Lines changed: 8 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,2 +1,8 @@
1-
let square = x => Utils.multiply(x, x)
2-
let double = x => Utils.add(x, x)
1+
open Utils
2+
3+
let square = x => multiply(x, x)
4+
let double = x => add(x, x)
5+
6+
module M = {
7+
let triple = x => multiply(x, 3)
8+
}

0 commit comments

Comments
 (0)