Unify code of ocamlcp and ocamloptp

5 files changed, 150 insertions, 161 deletions

diff --git a/tools/.depend b/tools/.depend
index 3fcdd5dd1a..1bc67fe928 100644
--- a/tools/.depend
+++ b/tools/.depend
@@ -145,9 +145,15 @@ ocamlcmt.cmx : \
     ../utils/clflags.cmx \
     ../typing/annot.cmi
 ocamlcp.cmo : \
+    ocamlcp_common.cmo \
+    ../driver/main_args.cmi
+ocamlcp.cmx : \
+    ocamlcp_common.cmx \
+    ../driver/main_args.cmx
+ocamlcp_common.cmo : \
     ../driver/main_args.cmi \
     ../driver/compenv.cmi
-ocamlcp.cmx : \
+ocamlcp_common.cmx : \
     ../driver/main_args.cmx \
     ../driver/compenv.cmx
 ocamldep.cmo : \
@@ -167,11 +173,11 @@ ocamlmktop.cmx : \
     ../utils/config.cmx \
     ../utils/ccomp.cmx
 ocamloptp.cmo : \
-    ../driver/main_args.cmi \
-    ../driver/compenv.cmi
+    ocamlcp_common.cmo \
+    ../driver/main_args.cmi
 ocamloptp.cmx : \
-    ../driver/main_args.cmx \
-    ../driver/compenv.cmx
+    ocamlcp_common.cmx \
+    ../driver/main_args.cmx
 ocamlprof.cmo : \
     ../utils/warnings.cmi \
     ../parsing/parsetree.cmi \
diff --git a/tools/Makefile b/tools/Makefile
index b4d805384f..fffcfe6cbe 100644
--- a/tools/Makefile
+++ b/tools/Makefile
@@ -100,7 +100,7 @@ OCAMLCP = config.cmo build_path_prefix_map.cmo misc.cmo profile.cmo \
           warnings.cmo identifiable.cmo numbers.cmo arg_helper.cmo \
           clflags.cmo local_store.cmo \
           terminfo.cmo location.cmo load_path.cmo ccomp.cmo compenv.cmo \
-          main_args.cmo
+          main_args.cmo ocamlcp_common.cmo
 
 ocamlcp$(EXE): $(OCAMLCP) ocamlcp.cmo
 ocamlcp.opt$(EXE): $(call byte2native, $(OCAMLCP) ocamlcp.cmo)
diff --git a/tools/ocamlcp.ml b/tools/ocamlcp.ml
index 2664a9d918..141f319894 100644
--- a/tools/ocamlcp.ml
+++ b/tools/ocamlcp.ml
@@ -13,81 +13,13 @@
 (*                                                                        *)
 (**************************************************************************)
 
-open Printf
-
-let make_archive = ref false
-let with_impl = ref false
-let with_intf = ref false
-let with_mli = ref false
-let with_ml = ref false
-
-let process_file filename =
-  if Filename.check_suffix filename ".ml" then with_ml := true;
-  if Filename.check_suffix filename ".mli" then with_mli := true
-
-let usage = "Usage: ocamlcp <options> <files>\noptions are:"
-
-let incompatible o =
-  fprintf stderr "ocamlcp: profiling is incompatible with the %s option\n" o;
-  exit 2
-
-module Options = Main_args.Make_bytecomp_options (struct
-    include Main_args.Default.Main
-    let _a () = make_archive := true
-    let _impl _ = with_impl := true
-    let _intf _ = with_intf := true
-    let _pp _ = incompatible "-pp"
-    let _ppx _ = incompatible "-ppx"
-    let anonymous = process_file
-  end)
-
-let rev_compargs = ref ([] : string list)
-let rev_profargs = ref ([] : string list)
-
-let add_profarg s =
-  rev_profargs := (Filename.quote s) :: "-m" :: !rev_profargs
-
-let anon filename =
-  process_file filename;
-  rev_compargs := Filename.quote filename :: !rev_compargs
-;;
-
-let optlist =
-    ("-P", Arg.String add_profarg,
-           "[afilmt]  Profile constructs specified by argument (default fm):\n\
-        \032     a  Everything\n\
-        \032     f  Function calls and method calls\n\
-        \032     i  if ... then ... else\n\
-        \032     l  while and for loops\n\
-        \032     m  match ... with\n\
-        \032     t  try ... with")
-    :: ("-p", Arg.String add_profarg, "[afilmt]  Same as option -P")
-    :: Main_args.options_with_command_line_syntax Options.list rev_compargs
-in
-begin try
-  Arg.parse_expand optlist anon usage
-with Compenv.Exit_with_status n -> exit n
-end;
-if !with_impl && !with_intf then begin
-  fprintf stderr "ocamlcp cannot deal with both \"-impl\" and \"-intf\"\n";
-  fprintf stderr "please compile interfaces and implementations separately\n";
-  exit 2;
-end else if !with_impl && !with_mli then begin
-  fprintf stderr "ocamlcp cannot deal with both \"-impl\" and .mli files\n";
-  fprintf stderr "please compile interfaces and implementations separately\n";
-  exit 2;
-end else if !with_intf && !with_ml then begin
-  fprintf stderr "ocamlcp cannot deal with both \"-intf\" and .ml files\n";
-  fprintf stderr "please compile interfaces and implementations separately\n";
-  exit 2;
-end;
-if !with_impl then rev_profargs := "-impl" :: !rev_profargs;
-if !with_intf then rev_profargs := "-intf" :: !rev_profargs;
-let status =
-  ksprintf Sys.command
-    "ocamlc -pp \"ocamlprof -instrument %s\" -I +profiling %s %s"
-      (String.concat " " (List.rev !rev_profargs))
-      (if !make_archive then "" else "profiling.cmo")
-      (String.concat " " (List.rev !rev_compargs))
-in
-exit status
+include Ocamlcp_common.Make(struct
+  let bytecode = true
+  module Make_options(Args : Ocamlcp_common.Ocamlcp_args) =
+    Main_args.Make_bytecomp_options(struct
+      include Main_args.Default.Main
+      include Args
+    end)
+end)
+
+let () = main ()
diff --git a/tools/ocamlcp_common.ml b/tools/ocamlcp_common.ml
new file mode 100644
index 0000000000..9d2df7d24d
--- /dev/null
+++ b/tools/ocamlcp_common.ml
@@ -0,0 +1,120 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 1998 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+module type Ocamlcp_args = sig
+  val _a : unit -> unit
+  val _impl : string -> unit
+  val _intf : string -> unit
+  val _pp : string -> unit
+  val _ppx : string -> unit
+  val anonymous : string -> unit
+end
+
+module type OCAMLCP = sig
+  val bytecode : bool
+  module Make_options : Ocamlcp_args -> Main_args.Arg_list
+end
+
+module Make(T: OCAMLCP) = struct
+  let name = if T.bytecode then "ocamlcp" else "ocamloptp"
+
+  let make_archive = ref false
+  let with_impl = ref false
+  let with_intf = ref false
+  let with_mli = ref false
+  let with_ml = ref false
+
+  let process_file filename =
+    if Filename.check_suffix filename ".ml" then with_ml := true;
+    if Filename.check_suffix filename ".mli" then with_mli := true
+
+  let usage = "Usage: " ^ name ^ " <options> <files>\noptions are:"
+
+  let incompatible o =
+    Printf.eprintf "%s: profiling is incompatible with the %s option\n" name o;
+    exit 2
+
+  module Options = T.Make_options(struct
+    (* Pre-process the options to ensure that the call to the compiler will
+       succeed. Only the affected options are overridden. *)
+    let _a () = make_archive := true
+    let _impl _ = with_impl := true
+    let _intf _ = with_intf := true
+    let _pp _ = incompatible "-pp"
+    let _ppx _ = incompatible "-ppx"
+    let anonymous = process_file
+  end)
+
+  let rev_compargs = ref ([] : string list)
+  let rev_profargs = ref ([] : string list)
+
+  let add_profarg s =
+    rev_profargs := (Filename.quote s) :: "-m" :: !rev_profargs
+
+  let anon filename =
+    process_file filename;
+    rev_compargs := Filename.quote filename :: !rev_compargs
+
+  let optlist =
+    let profarg =
+      ("-P", Arg.String add_profarg,
+            "[afilmt]  Profile constructs specified by argument (default fm):\n\
+          \032     a  Everything\n\
+          \032     f  Function calls and method calls\n\
+          \032     i  if ... then ... else\n\
+          \032     l  while and for loops\n\
+          \032     m  match ... with\n\
+          \032     t  try ... with") in
+    let inherited_options =
+      Main_args.options_with_command_line_syntax Options.list rev_compargs in
+    if T.bytecode then
+      profarg
+      (* Add the legacy "-p" option *)
+      :: ("-p", Arg.String add_profarg, "[afilmt]  Same as option -P")
+      :: inherited_options
+    else
+      profarg
+      :: inherited_options
+
+  let main () =
+    begin try
+      Arg.parse_expand optlist anon usage
+    with Compenv.Exit_with_status n -> exit n
+    end;
+    let cannot_deal_with a b =
+      Printf.eprintf
+        "%s cannot deal with both \"%s\" and %s\n\
+         please compile interfaces and implementations separately\n" name a b;
+      exit 2 in
+    if !with_impl && !with_intf then
+      cannot_deal_with "-impl" "\"-intf\""
+    else if !with_impl && !with_mli then
+      cannot_deal_with "-impl" ".mli files"
+    else if !with_intf && !with_ml then
+      cannot_deal_with "-intf" ".ml files";
+    if !with_impl then rev_profargs := "-impl" :: !rev_profargs;
+    if !with_intf then rev_profargs := "-intf" :: !rev_profargs;
+    let status =
+      let profiling_object =
+        if T.bytecode then "profiling.cmo" else "profiling.cmx" in
+      Printf.ksprintf Sys.command
+        "%s -pp \"ocamlprof -instrument %s\" -I +profiling %s %s"
+          (if T.bytecode then "ocamlc" else "ocamlopt")
+          (String.concat " " (List.rev !rev_profargs))
+          (if !make_archive then "" else profiling_object)
+          (String.concat " " (List.rev !rev_compargs))
+    in
+    exit status
+end
diff --git a/tools/ocamloptp.ml b/tools/ocamloptp.ml
index 8ca381cdf1..85614e3f99 100644
--- a/tools/ocamloptp.ml
+++ b/tools/ocamloptp.ml
@@ -13,82 +13,13 @@
 (*                                                                        *)
 (**************************************************************************)
 
-open Printf
-
-let make_archive = ref false
-let with_impl = ref false
-let with_intf = ref false
-let with_mli = ref false
-let with_ml = ref false
-
-let process_file filename =
-  if Filename.check_suffix filename ".ml" then with_ml := true;
-  if Filename.check_suffix filename ".mli" then with_mli := true
-
-let usage = "Usage: ocamloptp <options> <files>\noptions are:"
-
-let incompatible o =
-  fprintf stderr "ocamloptp: profiling is incompatible with the %s option\n" o;
-  exit 2
-
-module Options = Main_args.Make_optcomp_options (struct
-  include Main_args.Default.Optmain
-  let _a () = make_archive := true
-  let _impl _ = with_impl := true
-  let _intf _ = with_intf := true
-  let _pp _s = incompatible "-pp"
-  let _ppx _s = incompatible "-ppx"
-  let _args = Arg.read_arg
-  let _args0 = Arg.read_arg0
-  let anonymous = process_file
+include Ocamlcp_common.Make(struct
+  let bytecode = false
+  module Make_options(Args : Ocamlcp_common.Ocamlcp_args) =
+    Main_args.Make_optcomp_options(struct
+      include Main_args.Default.Optmain
+      include Args
+    end)
 end)
 
-let rev_compargs = ref ([] : string list)
-let rev_profargs = ref ([] : string list)
-
-let add_profarg s =
-  rev_profargs := (Filename.quote s) :: "-m" :: !rev_profargs
-
-let anon filename =
-  process_file filename;
-  rev_compargs := Filename.quote filename :: !rev_compargs
-;;
-
-let optlist =
-    ("-P", Arg.String add_profarg,
-           "[afilmt]  Profile constructs specified by argument (default fm):\n\
-        \032     a  Everything\n\
-        \032     f  Function calls and method calls\n\
-        \032     i  if ... then ... else\n\
-        \032     l  while and for loops\n\
-        \032     m  match ... with\n\
-        \032     t  try ... with")
-    :: Main_args.options_with_command_line_syntax Options.list rev_compargs
-in
-begin try
-  Arg.parse_expand optlist anon usage
-with Compenv.Exit_with_status n -> exit n
-end;
-if !with_impl && !with_intf then begin
-  fprintf stderr "ocamloptp cannot deal with both \"-impl\" and \"-intf\"\n";
-  fprintf stderr "please compile interfaces and implementations separately\n";
-  exit 2;
-end else if !with_impl && !with_mli then begin
-  fprintf stderr "ocamloptp cannot deal with both \"-impl\" and .mli files\n";
-  fprintf stderr "please compile interfaces and implementations separately\n";
-  exit 2;
-end else if !with_intf && !with_ml then begin
-  fprintf stderr "ocamloptp cannot deal with both \"-intf\" and .ml files\n";
-  fprintf stderr "please compile interfaces and implementations separately\n";
-  exit 2;
-end;
-if !with_impl then rev_profargs := "-impl" :: !rev_profargs;
-if !with_intf then rev_profargs := "-intf" :: !rev_profargs;
-let status =
-  ksprintf Sys.command
-    "ocamlopt -pp \"ocamlprof -instrument %s\" -I +profiling %s %s"
-      (String.concat " " (List.rev !rev_profargs))
-      (if !make_archive then "" else "profiling.cmx")
-      (String.concat " " (List.rev !rev_compargs))
-in
-exit status
+let () = main ()