commit o_and_opens.diff

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@14787 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

Changes

@@ -52,6 +52,10 @@ Compilers:
 - Experimental native code generator for AArch64 (ARM 64 bits)
 - Optimization of integer division and modulus by constant divisors
   (feature wish PR#6042)
+- Add "-open" command line flag for opening a single module before typing
+* "-o" now sets module name to the output file name up to the first "."
+  (it also applies when "-o" is not given, i.e. the module name is then
+   the input file name up to the first ".")
 - PR#6182: better message for virtual objects and class types
   (Leo P. White, Stephen Dolan)
 - PR#5817: new flag to keep locations in cmi files

driver/compenv.ml

@@ -55,7 +55,7 @@ let last_ppx = ref []
 let first_objfiles = ref []
 let last_objfiles = ref []
 
-(* Note: this function is duplicated in optcompile.ml *)
+(* Check validity of module name *)
 let check_unit_name ppf filename name =
   try
     begin match name.[0] with
@@ -76,10 +76,19 @@ let check_unit_name ppf filename name =
   with Exit -> ()
 ;;
 
-
-
-
-
+(* Compute name of module from output file name *)
+let module_of_filename ppf inputfile outputprefix =
+  let basename = Filename.basename outputprefix in
+  let name =
+    try
+      let pos = String.index basename '.' in
+      String.sub basename 0 pos
+    with Not_found -> basename
+  in
+  let name = String.capitalize name in
+  check_unit_name ppf inputfile name;
+  name
+;;
 
 
 type readenv_position =

driver/compenv.mli

@@ -10,7 +10,8 @@
 (*                                                                     *)
 (***********************************************************************)
 
-val check_unit_name : Format.formatter -> string -> string -> unit
+(* val check_unit_name : Format.formatter -> string -> string -> unit *)
+val module_of_filename : Format.formatter -> string -> string -> string
 
 val output_prefix : string -> string
 val extract_output : string option -> string

driver/compile.ml

@@ -23,9 +23,7 @@ open Compenv
 
 let interface ppf sourcefile outputprefix =
   Compmisc.init_path false;
-  let modulename =
-    String.capitalize(Filename.basename(chop_extension_if_any sourcefile)) in
-  check_unit_name ppf sourcefile modulename;
+  let modulename = module_of_filename ppf sourcefile outputprefix in
   Env.set_unit_name modulename;
   let initial_env = Compmisc.initial_env () in
   let ast = Pparse.parse_interface ppf sourcefile in
@@ -57,9 +55,7 @@ let (++) x f = f x
 
 let implementation ppf sourcefile outputprefix =
   Compmisc.init_path false;
-  let modulename =
-    String.capitalize(Filename.basename(chop_extension_if_any sourcefile)) in
-  check_unit_name ppf sourcefile modulename;
+  let modulename = module_of_filename ppf sourcefile outputprefix in
   Env.set_unit_name modulename;
   let env = Compmisc.initial_env() in
   if !Clflags.print_types then begin

driver/compmisc.ml

@@ -57,4 +57,4 @@ let initial_env () =
   in
   List.fold_left (fun env m ->
     open_implicit_module m env
-  ) env !implicit_modules
+  ) env (!implicit_modules @ List.rev !Clflags.open_module)

driver/main.ml

@@ -103,6 +103,7 @@ module Options = Main_args.Make_bytecomp_options (struct
   let _noautolink = set no_auto_link
   let _nostdlib = set no_std_include
   let _o s = output_name := Some s
+  let _open s = open_module := s :: !open_module
   let _output_obj () = output_c_object := true; custom_runtime := true
   let _pack = set make_package
   let _pp s = preprocessor := Some s

driver/main_args.ml

@@ -208,6 +208,9 @@ let mk_o f =
   "-o", Arg.String f, "<file>  Set output file name to <file>"
 ;;
 
+let mk_open f =
+  "-open", Arg.String f, "<module>  Opens the module <module> before typing"
+
 let mk_output_obj f =
   "-output-obj", Arg.Unit f, " Output a C object file instead of an executable"
 ;;
@@ -456,6 +459,7 @@ module type Common_options = sig
   val _noassert : unit -> unit
   val _nolabels : unit -> unit
   val _nostdlib : unit -> unit
+  val _open : string -> unit
   val _ppx : string -> unit
   val _principal : unit -> unit
   val _rectypes : unit -> unit

driver/main_args.mli

@@ -19,6 +19,7 @@ module type Common_options = sig
   val _noassert : unit -> unit
   val _nolabels : unit -> unit
   val _nostdlib : unit -> unit
+  val _open : string -> unit
   val _ppx : string -> unit
   val _principal : unit -> unit
   val _rectypes : unit -> unit

driver/optcompile.ml

@@ -24,9 +24,7 @@ open Compenv
 
 let interface ppf sourcefile outputprefix =
   Compmisc.init_path false;
-  let modulename =
-    String.capitalize(Filename.basename(chop_extension_if_any sourcefile)) in
-  check_unit_name ppf sourcefile modulename;
+  let modulename = module_of_filename ppf sourcefile outputprefix in
   Env.set_unit_name modulename;
   let initial_env = Compmisc.initial_env () in
   let ast = Pparse.parse_interface ppf sourcefile in
@@ -59,9 +57,7 @@ let (+++) (x, y) f = (x, f y)
 
 let implementation ppf sourcefile outputprefix =
   Compmisc.init_path true;
-  let modulename =
-    String.capitalize(Filename.basename(chop_extension_if_any sourcefile)) in
-  check_unit_name ppf sourcefile modulename;
+  let modulename = module_of_filename ppf sourcefile outputprefix in
   Env.set_unit_name modulename;
   let env = Compmisc.initial_env() in
   Compilenv.reset ?packname:!Clflags.for_package modulename;

driver/optmain.ml

@@ -102,6 +102,7 @@ module Options = Main_args.Make_optcomp_options (struct
   let _nolabels = set classic
   let _nostdlib = set no_std_include
   let _o s = output_name := Some s
+  let _open s = open_module := s :: !open_module
   let _output_obj = set output_c_object
   let _p = set gprofile
   let _pack = set make_package

man/ocaml.m

@@ -133,6 +133,12 @@ window.
 Do not include the standard library directory in the list of
 directories searched for source and compiled files.
 .TP
+.BI \-open \ module
+Opens the given module before starting the toplevel. If several
+.B \-open
+options are given, they are processed in order, just as if
+the statements open module1;; ... open moduleN;; were input.
+.TP
 .BI \-ppx \ command
 After parsing, pipe the abstract syntax tree through the preprocessor
 .IR command .

man/ocamlc.m

@@ -449,6 +449,18 @@ packed object file produced.  If the
 .B \-output\-obj
 option is given,
 specify the name of the output file produced.
+This can also be used when compiling an interface or implementation
+file, without linking, in which case it sets the name of the cmi or
+cmo file, and also sets the module name to the file name up to the
+first dot.
+.TP
+.BI \-open \ module
+Opens the given module before processing the interface or
+implementation files. If several
+.B \-open
+options are given, they are processed in order, just as if
+the statements open module1;; ... open moduleN;; were added
+at the top of each file.
 .TP
 .B \-output\-obj
 Cause the linker to produce a C object file instead of a bytecode

man/ocamlopt.m

@@ -367,6 +367,18 @@ If the
 option is given, specify the name of the output file produced. If the
 .B \-shared
 option is given, specify the name of plugin file produced.
+This can also be used when compiling an interface or implementation
+file, without linking, in which case it sets the name of the cmi or
+cmo file, and also sets the module name to the file name up to the
+first dot.
+.TP
+.BI \-open \ module
+Opens the given module before processing the interface or
+implementation files. If several
+.B \-open
+options are given, they are processed in order, just as if
+the statements open module1;; ... open moduleN;; were added
+at the top of each file.
 .TP
 .B \-output\-obj
 Cause the linker to produce a C object file instead of an executable

tools/ocamlcp.ml

@@ -71,6 +71,7 @@ module Options = Main_args.Make_bytecomp_options (struct
   let _noautolink = option "-noautolink"
   let _nostdlib = option "-nostdlib"
   let _o s = option_with_arg "-o" s
+  let _open s = option_with_arg "-open" s
   let _output_obj = option "-output-obj"
   let _pack = option "-pack"
   let _pp s = incompatible "-pp"

tools/ocamloptp.ml

@@ -73,6 +73,7 @@ module Options = Main_args.Make_optcomp_options (struct
   let _nolabels = option "-nolabels"
   let _nostdlib = option "-nostdlib"
   let _o s = option_with_arg "-o" s
+  let _open s = option_with_arg "-open" s
   let _output_obj = option "-output-obj"
   let _p = option "-p"
   let _pack = option "-pack"

toplevel/topmain.ml

@@ -74,6 +74,7 @@ module Options = Main_args.Make_bytetop_options (struct
   let _noprompt = set noprompt
   let _nopromptcont = set nopromptcont
   let _nostdlib = set no_std_include
+  let _open s = open_module := s :: !open_module
   let _ppx s = first_ppx := s :: !first_ppx
   let _principal = set principal
   let _rectypes = set recursive_types

utils/clflags.ml

@@ -43,6 +43,7 @@ and noprompt = ref false                (* -noprompt *)
 and nopromptcont = ref false            (* -nopromptcont *)
 and init_file = ref (None : string option)   (* -init *)
 and noinit = ref false                  (* -noinit *)
+and open_module = ref []                (* -open *)
 and use_prims = ref ""                  (* -use-prims ... *)
 and use_runtime = ref ""                (* -use-runtime ... *)
 and principal = ref false               (* -principal *)

utils/clflags.mli

@@ -23,11 +23,12 @@ val debug : bool ref
 val fast : bool ref
 val link_everything : bool ref
 val custom_runtime : bool ref
-val bytecode_compatible_32: bool ref
+val bytecode_compatible_32 : bool ref
 val output_c_object : bool ref
 val all_ccopts : string list ref
 val classic : bool ref
 val nopervasives : bool ref
+val open_module : string list ref
 val preprocessor : string option ref
 val all_ppx : string list ref
 val annotations : bool ref