forked from
anil.recoil.org/monopam
Monorepo management for opam overlays
monopam: skip virtual-library impls in Dead_lib detection
Virtual library implementations (stanzas with '(implements X)') are
linked solely on the basis of being the impl chosen for X. Their
modules don't have to appear in the consumer's source — that's the
whole point of the virtual/impl indirection. Flagging them as Dead_lib
is a false positive (e.g. helix.jx.jsoo for ocaml-globe/demo).
Track impl libs in a separate set in the build_lib_index, and skip
them in dead_libs_in_subtree. Renames build_lib_modules to
build_lib_index since it now returns a (modules, virtual_impls) record.
+66
-20
+66
-20
lib/lint.ml
+66
-20
lib/lint.ml
···
439
439
^ String.sub s 1 (String.length s - 1)
440
440
441
441
(** Walk every (library ...) sub-stanza of a parsed dune-package file and return
442
-
a list of (lib_name, module_set) pairs. *)
442
+
a list of [(lib_name, module_set, is_implementation)] tuples.
443
+
[is_implementation = true] when the stanza has [(implements X)] — a concrete
444
+
impl of a virtual library, always link-time live even when its modules
445
+
aren't named in source. *)
443
446
let libraries_in_dune_package sexps =
444
447
let module_set_of_main fields =
445
448
match field "main_module_name" fields with
···
466
469
| Some xs -> List.fold_left module_set_of_modules mods xs
467
470
| None -> mods
468
471
in
469
-
Some (name, mods)
472
+
let is_impl = field "implements" fields <> None in
473
+
Some (name, mods, is_impl)
470
474
| _ -> None)
471
475
| _ -> None)
472
476
sexps
···
498
502
else acc)
499
503
String_set.empty entries
500
504
505
+
type lib_index = {
506
+
modules : (string, String_set.t) Hashtbl.t;
507
+
(** Library name -> set of exposed top-level modules. *)
508
+
virtual_impls : (string, unit) Hashtbl.t;
509
+
(** Library names that implement a virtual library — always link-time live
510
+
even when none of their modules appear in source. *)
511
+
}
512
+
501
513
(** Scan [_opam/lib/] and [_build/install/.../lib/] for libraries. For each
502
514
package directory, prefer [dune-package]'s precise metadata; fall back to
503
515
listing [*.cmi]. *)
504
-
let build_lib_modules ~fs ~monorepo =
505
-
let tbl = Hashtbl.create 256 in
516
+
let build_lib_index ~fs ~monorepo =
517
+
let modules = Hashtbl.create 256 in
518
+
let virtual_impls = Hashtbl.create 16 in
506
519
let scan root =
507
520
let entries = try Eio.Path.read_dir root with Eio.Io _ -> [] in
508
521
List.iter
···
515
528
| Some content ->
516
529
let libs = libraries_in_dune_package (parse_sexps content) in
517
530
List.iter
518
-
(fun (name, mods) ->
531
+
(fun (name, mods, is_impl) ->
532
+
if is_impl then Hashtbl.replace virtual_impls name ();
519
533
if not (String_set.is_empty mods) then begin
520
534
covered := true;
521
535
let existing =
522
-
try Hashtbl.find tbl name
536
+
try Hashtbl.find modules name
523
537
with Not_found -> String_set.empty
524
538
in
525
-
Hashtbl.replace tbl name (String_set.union existing mods)
539
+
Hashtbl.replace modules name (String_set.union existing mods)
526
540
end)
527
541
libs);
528
542
if not !covered then
529
543
let mods = cmi_modules_in_dir pkg_dir in
530
544
if not (String_set.is_empty mods) then
531
545
let existing =
532
-
try Hashtbl.find tbl pkg with Not_found -> String_set.empty
546
+
try Hashtbl.find modules pkg with Not_found -> String_set.empty
533
547
in
534
-
Hashtbl.replace tbl pkg (String_set.union existing mods))
548
+
Hashtbl.replace modules pkg (String_set.union existing mods))
535
549
entries
536
550
in
537
551
let opam_lib =
···
545
559
in
546
560
scan opam_lib;
547
561
scan build_lib;
548
-
tbl
562
+
{ modules; virtual_impls }
549
563
550
564
let module_ref_re =
551
565
Re.compile
···
563
577
|> List.map (fun g -> Re.Group.get g 0)
564
578
|> String_set.of_list
565
579
566
-
(** Concatenated text of every [.ml] / [.mli] in [dir]. *)
567
-
let source_files_text ~fs dir =
580
+
(** Concatenated text of every [.ml] / [.mli] in [dir]. When [recurse] is set,
581
+
descend into subdirectories that do not have their own [dune] file (since
582
+
those belong to a different stanza). Used for [(include_subdirs ...)]. *)
583
+
let rec source_files_text ~fs ~recurse dir =
568
584
let eio_dir = Eio.Path.(fs / Fpath.to_string dir) in
569
585
let entries = try Eio.Path.read_dir eio_dir with Eio.Io _ -> [] in
570
586
List.fold_left
571
587
(fun acc entry ->
572
-
if Filename.check_suffix entry ".mli" || Filename.check_suffix entry ".ml"
588
+
if String.starts_with ~prefix:"." entry then acc
589
+
else if entry = "_build" || entry = "_opam" then acc
590
+
else if
591
+
Filename.check_suffix entry ".mli" || Filename.check_suffix entry ".ml"
573
592
then
574
593
match load_file fs Fpath.(dir / entry) with
575
594
| Some s -> acc ^ "\n" ^ s
576
595
| None -> acc
596
+
else if recurse then
597
+
let child = Fpath.(dir / entry) in
598
+
let eio_child = Eio.Path.(fs / Fpath.to_string child) in
599
+
match Eio.Path.kind ~follow:false eio_child with
600
+
| `Directory ->
601
+
let has_dune =
602
+
match
603
+
Eio.Path.kind ~follow:false Eio.Path.(eio_child / "dune")
604
+
with
605
+
| `Regular_file -> true
606
+
| _ -> false
607
+
| exception Eio.Io _ -> false
608
+
in
609
+
if has_dune then acc
610
+
else acc ^ "\n" ^ source_files_text ~fs ~recurse child
611
+
| _ -> acc
612
+
| exception Eio.Io _ -> acc
577
613
else acc)
578
614
"" entries
579
615
616
+
(** True if any top-level stanza in [sexps] is [(include_subdirs X)] with [X]
617
+
not equal to [no]. *)
618
+
let has_include_subdirs sexps =
619
+
List.exists
620
+
(function
621
+
| Sexp.List [ Sexp.Atom "include_subdirs"; Sexp.Atom mode ] ->
622
+
mode <> "no"
623
+
| _ -> false)
624
+
sexps
625
+
580
626
(** Walk the subtree, for each [library] / [executable] / [executables] / [test]
581
627
/ [tests] stanza, check each [(libraries L)] entry against the stanza's
582
628
directory's source. *)
583
-
let dead_libs_in_subtree ~fs ~lib_modules ~subtree subtree_path =
629
+
let dead_libs_in_subtree ~fs ~lib_index ~subtree subtree_path =
584
630
let dune_files = dune_files_in ~fs subtree_path in
585
631
List.concat_map
586
632
(fun df ->
···
589
635
| None -> []
590
636
| Some content ->
591
637
let stanzas = parse_sexps content in
592
-
let refs = module_refs_in_text (source_files_text ~fs dir) in
638
+
let recurse = has_include_subdirs stanzas in
639
+
let refs = module_refs_in_text (source_files_text ~fs ~recurse dir) in
593
640
List.concat_map
594
641
(function
595
642
| Sexp.List (Sexp.Atom kind :: fields)
···
612
659
List.filter_map
613
660
(fun lib ->
614
661
if is_builtin lib then None
662
+
else if Hashtbl.mem lib_index.virtual_impls lib then None
615
663
else
616
-
match Hashtbl.find_opt lib_modules lib with
664
+
match Hashtbl.find_opt lib_index.modules lib with
617
665
| None -> None
618
666
(* Unknown lib: don't flag — could be a sibling
619
667
library with a private name, or a build system
···
895
943
let build_lib = Fpath.(monorepo / "_build" / "install" / "default" / "lib") in
896
944
let subdirs = list_subdirs ~fs ~monorepo in
897
945
let sources = load_sources ~fs ~monorepo in
898
-
let lib_modules = build_lib_modules ~fs ~monorepo in
946
+
let lib_index = build_lib_index ~fs ~monorepo in
899
947
let source_issues =
900
948
compute_source_issues ~fs ~monorepo ~sources subdirs |> sort_source_issues
901
949
in
···
938
986
in
939
987
issues := new_issues @ !issues)
940
988
pkgs;
941
-
let dead =
942
-
dead_libs_in_subtree ~fs ~lib_modules ~subtree subtree_path
943
-
in
989
+
let dead = dead_libs_in_subtree ~fs ~lib_index ~subtree subtree_path in
944
990
issues := dead @ !issues
945
991
end)
946
992
subdirs;