diff --git a/src/top/dune b/src/top/dune index af7d175..f94d184 100644 --- a/src/top/dune +++ b/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} - %{targets} %{lib:compiler-libs.common:ocamlcommon.cma} - %{lib:compiler-libs.bytecomp:ocamlbytecomp.cma} - %{lib:compiler-libs.toplevel:ocamltoplevel.cma}))) + (run %{ocaml_where}/expunge %{dep:utop.bc} %{targets} + %{read-lines:modules.txt}))) (install (section bin) diff --git a/src/top/expunge/dune b/src/top/expunge/dune index 4d6bf78..1c5afee 100644 --- a/src/top/expunge/dune +++ b/src/top/expunge/dune @@ -1,3 +1,2 @@ (executable - (name expunge) - (libraries unix)) + (name modules)) diff --git a/src/top/expunge/expunge.ml b/src/top/expunge/expunge.ml deleted file mode 100644 index d3989f2..0000000 --- a/src/top/expunge/expunge.ml +++ /dev/null @@ -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" diff --git a/src/top/expunge/modules.ml b/src/top/expunge/modules.ml new file mode 100644 index 0000000..45ed02c --- /dev/null +++ b/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"