expunge: move system code to dune (#439)

The logic to create utop from utop-full is as follows:

- use ocamlobjinfo on utop-full to determine which modules are used
- use ocamlobjinfo on ocamlcommon, ocamlbytecomp, and ocamltoplevel to
  determine which modules to exclude (a priori)
- compute the set used - (exclude - {Topmain,Toploop,Topdirs})
- call expunge with this set of modules

Previously, this was all done in expunge/expunge.ml, meaning core logic
+ process handling.
What this PR does is offload the process handling to dune: calling
ocamlobjinfo and expunge is done instead in dune rules, and
expunge/modules.ml is just about reading sets of module names and
outputing the result.

Besides simplicity and portability, the other advantage is that the
intermediate modules.txt can be inspected directly.
This commit is contained in:
Etienne Millon 2023-06-23 13:56:38 +02:00 committed by GitHub
parent bfabaacf2a
commit e885c5ee93
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
4 changed files with 81 additions and 82 deletions

View File

@ -4,14 +4,37 @@
(modes byte) (modes byte)
(link_flags -linkall)) (link_flags -linkall))
(rule
(with-stdout-to
info-ocamlcommon.txt
(run %{bin:ocamlobjinfo} %{lib:compiler-libs.common:ocamlcommon.cma})))
(rule
(with-stdout-to
info-ocamlbytecomp.txt
(run %{bin:ocamlobjinfo} %{lib:compiler-libs.bytecomp:ocamlbytecomp.cma})))
(rule
(with-stdout-to
info-ocamltoplevel.txt
(run %{bin:ocamlobjinfo} %{lib:compiler-libs.toplevel:ocamltoplevel.cma})))
(rule
(with-stdout-to
info-utop.txt
(run %{bin:ocamlobjinfo} %{dep:utop.bc})))
(rule
(with-stdout-to
modules.txt
(run ./expunge/modules.exe %{dep:info-utop.txt} %{dep:info-ocamlcommon.txt}
%{dep:info-ocamlbytecomp.txt} %{dep:info-ocamltoplevel.txt})))
(rule (rule
(targets utop-expunged.bc) (targets utop-expunged.bc)
(deps utop.bc)
(action (action
(run %{exe:expunge/expunge.exe} %{bin:ocamlobjinfo} %{ocaml_where} %{deps} (run %{ocaml_where}/expunge %{dep:utop.bc} %{targets}
%{targets} %{lib:compiler-libs.common:ocamlcommon.cma} %{read-lines:modules.txt})))
%{lib:compiler-libs.bytecomp:ocamlbytecomp.cma}
%{lib:compiler-libs.toplevel:ocamltoplevel.cma})))
(install (install
(section bin) (section bin)

View File

@ -1,3 +1,2 @@
(executable (executable
(name expunge) (name modules))
(libraries unix))

View File

@ -1,75 +0,0 @@
open StdLabels
open Printf
let run_and_read_lines args =
let cmd = String.concat ~sep:" " (List.map args ~f:Filename.quote) in
let cmd = if Sys.win32 then "\"" ^ cmd ^ "\"" else cmd in
let ic = Unix.open_process_in cmd in
let rec loop acc =
match input_line ic with
| exception End_of_file -> List.rev acc
| line -> loop (line :: acc)
in
let x = loop [] in
match Unix.close_process_in ic with
| WEXITED 0 -> x
| WEXITED n ->
eprintf "Process `%s' exited with code %d\n%!" cmd n;
exit 1
| WSIGNALED n ->
eprintf "Process `%s' got signal %d\n%!" cmd n;
exit 1
| WSTOPPED _ -> assert false
module S = Set.Make(String)
let main ~objinfo ~stdlib_dir ~src ~dst ~cma_files ~verbose =
let modules =
run_and_read_lines [objinfo; src]
|> List.map ~f:(fun line ->
try
Scanf.sscanf line "\t%[0-9a-f]\t%s"
(fun a b -> assert (String.length a = 32); [b])
with _ -> [])
|> List.concat
|> S.of_list
in
let modules_to_exclude =
List.map cma_files ~f:(fun fn ->
run_and_read_lines [objinfo; fn]
|> List.map ~f:(fun line ->
try
Scanf.sscanf line "Unit name: %s" (fun s -> [s])
with _ -> [])
|> List.concat)
|> List.concat
|> S.of_list
|> S.remove "Topmain"
|> S.remove "Toploop"
|> S.remove "Topdirs"
in
if verbose then begin
eprintf "Modules from the compiler:\n";
List.iter (S.elements modules_to_exclude) ~f:(eprintf "- %s\n")
end;
let modules_to_keep = S.diff modules modules_to_exclude in
let cmdline =
sprintf
"%s %s %s %s"
(Filename.quote (Filename.concat stdlib_dir "expunge"))
(Filename.quote src)
(Filename.quote dst)
(String.concat ~sep:" " (S.elements modules_to_keep))
in
let cmdline = if Sys.win32 then "\"" ^ cmdline ^ "\"" else cmdline in
if verbose then prerr_endline cmdline;
exit (Sys.command cmdline)
let () =
match Array.to_list Sys.argv with
| _ :: "-v" :: objinfo :: stdlib_dir :: src :: dst :: cma_files ->
main ~objinfo ~stdlib_dir ~src ~dst ~cma_files ~verbose:true
| _ :: objinfo :: stdlib_dir :: src :: dst :: cma_files ->
main ~objinfo ~stdlib_dir ~src ~dst ~cma_files ~verbose:false
| _ ->
failwith "invalid command line"

View File

@ -0,0 +1,52 @@
open StdLabels
let input_lines ic =
let rec loop acc =
match input_line ic with
| exception End_of_file -> List.rev acc
| line -> loop (line :: acc)
in
loop []
let lines_of_info fn =
let ic = open_in fn in
Fun.protect
(fun () -> input_lines ic)
~finally:(fun () -> close_in_noerr ic)
module S = Set.Make(String)
let main ~src ~cma_files =
let modules =
lines_of_info src
|> List.map ~f:(fun line ->
try
Scanf.sscanf line "\t%[0-9a-f]\t%s"
(fun a b -> assert (String.length a = 32); [b])
with _ -> [])
|> List.concat
|> S.of_list
in
let modules_to_exclude =
List.map cma_files ~f:(fun fn ->
lines_of_info fn
|> List.map ~f:(fun line ->
try
Scanf.sscanf line "Unit name: %s" (fun s -> [s])
with _ -> [])
|> List.concat)
|> List.concat
|> S.of_list
|> S.remove "Topmain"
|> S.remove "Toploop"
|> S.remove "Topdirs"
in
let modules_to_keep = S.diff modules modules_to_exclude in
S.iter print_endline modules_to_keep
let () =
match Array.to_list Sys.argv with
| _ :: src :: cma_files ->
main ~src ~cma_files
| _ ->
failwith "invalid command line"