From 2f64eb47854a0c4ce85c76e64b158599c0139a74 Mon Sep 17 00:00:00 2001
From: Jeremie Dimino <jdimino@janestreet.com>
Date: Tue, 4 Apr 2017 13:31:48 +0100
Subject: [PATCH] restore expunge

---
 src/top/expunge/expunge.ml | 73 ++++++++++++++++++++++++++++++++++++++
 src/top/expunge/jbuild     |  5 +++
 src/top/jbuild             | 15 +++++++-
 3 files changed, 92 insertions(+), 1 deletion(-)
 create mode 100644 src/top/expunge/expunge.ml
 create mode 100644 src/top/expunge/jbuild

diff --git a/src/top/expunge/expunge.ml b/src/top/expunge/expunge.ml
new file mode 100644
index 0000000..6908109
--- /dev/null
+++ b/src/top/expunge/expunge.ml
@@ -0,0 +1,73 @@
+open StdLabels
+open Printf
+
+let run_and_read_lines args =
+  let cmd = String.concat ~sep:" " (List.map args ~f:Filename.quote) 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
+  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"
diff --git a/src/top/expunge/jbuild b/src/top/expunge/jbuild
new file mode 100644
index 0000000..d41a15b
--- /dev/null
+++ b/src/top/expunge/jbuild
@@ -0,0 +1,5 @@
+(jbuild_version 1)
+
+(executable
+ ((name expunge)
+  (libraries (unix))))
diff --git a/src/top/jbuild b/src/top/jbuild
index ee3480c..ffd1a63 100644
--- a/src/top/jbuild
+++ b/src/top/jbuild
@@ -4,6 +4,19 @@
  ((names (utop))
   (libraries (utop))))
 
+(rule
+ ((targets (utop-expunged.bc))
+  (deps    (utop.bc))
+  (action  (run ${exe:expunge/expunge.exe}
+            ${bin:ocamlobjinfo}
+            ${ocaml_where}
+            ${<}
+            ${@}
+            ${lib:compiler-libs.common:ocamlcommon.cma}
+            ${lib:compiler-libs.bytecomp:ocamlbytecomp.cma}
+            ${lib:compiler-libs.toplevel:ocamltoplevel.cma}))))
+
 (install
  ((section bin)
-  (files ((utop.bc as utop-full)))))
+  (files ((utop-expunged.bc as utop)
+          (utop.bc          as utop-full)))))