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.

src/top/dune

@@ -4,14 +4,37 @@
  (modes byte)
  (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
  (targets utop-expunged.bc)
- (deps utop.bc)
  (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
  (section bin)

src/top/expunge/dune

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

src/top/expunge/expunge.ml

@@ -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"

src/top/expunge/modules.ml

@@ -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"