diff options
author | Damien Doligez <damien.doligez-inria.fr> | 2014-04-29 11:56:17 +0000 |
---|---|---|
committer | Damien Doligez <damien.doligez-inria.fr> | 2014-04-29 11:56:17 +0000 |
commit | 5b8df637d2b722aa397ab53200a733bae238e9fe (patch) | |
tree | 522cd6e4b131d3e0a7b4ddeac46bc4e1efdb2fad /driver | |
parent | 3ce32fba4fe8be1c77096ca1f70dd14233d67b49 (diff) | |
download | ocaml-5b8df637d2b722aa397ab53200a733bae238e9fe.tar.gz |
merge branch "safe-string"
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@14705 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
Diffstat (limited to 'driver')
-rw-r--r-- | driver/compenv.ml | 1 | ||||
-rw-r--r-- | driver/compmisc.ml | 10 | ||||
-rw-r--r-- | driver/main.ml | 5 | ||||
-rw-r--r-- | driver/main_args.ml | 32 | ||||
-rw-r--r-- | driver/main_args.mli | 8 | ||||
-rw-r--r-- | driver/optmain.ml | 5 | ||||
-rw-r--r-- | driver/pparse.ml | 6 |
7 files changed, 54 insertions, 13 deletions
diff --git a/driver/compenv.ml b/driver/compenv.ml index a40083275b..e2a90d29a6 100644 --- a/driver/compenv.ml +++ b/driver/compenv.ml @@ -158,6 +158,7 @@ let read_OCAMLPARAM ppf position = | "nolabels" -> set "nolabels" [ classic ] v | "principal" -> set "principal" [ principal ] v | "rectypes" -> set "rectypes" [ recursive_types ] v + | "safe-string" -> clear "safe-string" [ unsafe_string ] v | "strict-sequence" -> set "strict-sequence" [ strict_sequence ] v | "thread" -> set "thread" [ use_threads ] v | "unsafe" -> set "unsafe" [ fast ] v diff --git a/driver/compmisc.ml b/driver/compmisc.ml index 8f974f4be1..b97ba6c74e 100644 --- a/driver/compmisc.ml +++ b/driver/compmisc.ml @@ -47,11 +47,13 @@ let open_implicit_module m env = let initial_env () = Ident.reinit(); + let initial = + if !Clflags.unsafe_string then Env.initial_unsafe_string + else Env.initial_safe_string + in let env = - if !Clflags.nopervasives - then Env.initial - else - open_implicit_module "Pervasives" Env.initial + if !Clflags.nopervasives then initial else + open_implicit_module "Pervasives" initial in List.fold_left (fun env m -> open_implicit_module m env diff --git a/driver/main.ml b/driver/main.ml index cbb6459993..44df1208be 100644 --- a/driver/main.ml +++ b/driver/main.ml @@ -109,12 +109,14 @@ module Options = Main_args.Make_bytecomp_options (struct let _principal = set principal let _rectypes = set recursive_types let _runtime_variant s = runtime_variant := s + let _safe_string = unset unsafe_string let _short_paths = unset real_paths let _strict_sequence = set strict_sequence let _thread = set use_threads let _trans_mod = set transparent_modules let _vmthread = set use_vmthreads let _unsafe = set fast + let _unsafe_string = set unsafe_string let _use_prims s = use_prims := s let _use_runtime s = use_runtime := s let _v () = print_version_and_library "compiler" @@ -160,7 +162,8 @@ let main () = Compmisc.init_path false; let extracted_output = extract_output !output_name in let revd = get_objfiles () in - Bytepackager.package_files ppf revd (extracted_output); + Bytepackager.package_files ppf (Compmisc.initial_env ()) + revd (extracted_output); Warnings.check_fatal (); end else if not !compile_only && !objfiles <> [] then begin diff --git a/driver/main_args.ml b/driver/main_args.ml index f72a08fffd..1444ae4571 100644 --- a/driver/main_args.ml +++ b/driver/main_args.ml @@ -247,6 +247,14 @@ let mk_S f = "-S", Arg.Unit f, " Keep intermediate assembly file" ;; +let mk_safe_string f = + "-safe-string", Arg.Unit f, " Make strings immutable" +;; + +let mk_shared f = + "-shared", Arg.Unit f, " Produce a dynlinkable plugin" +;; + let mk_short_paths f = "-short-paths", Arg.Unit f, " Shorten paths in types" ;; @@ -260,10 +268,6 @@ let mk_strict_sequence f = " Left-hand part of a sequence must have type unit" ;; -let mk_shared f = - "-shared", Arg.Unit f, " Produce a dynlinkable plugin" -;; - let mk_thread f = "-thread", Arg.Unit f, " Generate code that supports the system threads library" @@ -278,6 +282,10 @@ let mk_unsafe f = " Do not compile bounds checking on array and string access" ;; +let mk_unsafe_string f = + "-unsafe-string", Arg.Unit f, " Make strings mutable (default)" +;; + let mk_use_runtime f = "-use-runtime", Arg.String f, "<file> Generate bytecode for the given runtime system" @@ -475,12 +483,14 @@ module type Bytecomp_options = sig val _principal : unit -> unit val _rectypes : unit -> unit val _runtime_variant : string -> unit + val _safe_string : unit -> unit val _short_paths : unit -> unit val _strict_sequence : unit -> unit val _trans_mod : unit -> unit val _thread : unit -> unit val _vmthread : unit -> unit val _unsafe : unit -> unit + val _unsafe_string : unit -> unit val _use_runtime : string -> unit val _v : unit -> unit val _version : unit -> unit @@ -518,11 +528,13 @@ module type Bytetop_options = sig val _ppx : string -> unit val _principal : unit -> unit val _rectypes : unit -> unit + val _safe_string : unit -> unit val _short_paths : unit -> unit val _stdin: unit -> unit val _strict_sequence : unit -> unit val _trans_mod : unit -> unit val _unsafe : unit -> unit + val _unsafe_string : unit -> unit val _version : unit -> unit val _vnum : unit -> unit val _w : string -> unit @@ -578,12 +590,14 @@ module type Optcomp_options = sig val _rectypes : unit -> unit val _runtime_variant : string -> unit val _S : unit -> unit + val _safe_string : unit -> unit val _shared : unit -> unit val _short_paths : unit -> unit val _strict_sequence : unit -> unit val _trans_mod : unit -> unit val _thread : unit -> unit val _unsafe : unit -> unit + val _unsafe_string : unit -> unit val _v : unit -> unit val _verbose : unit -> unit val _version : unit -> unit @@ -636,11 +650,13 @@ module type Opttop_options = sig val _principal : unit -> unit val _rectypes : unit -> unit val _S : unit -> unit + val _safe_string : unit -> unit val _short_paths : unit -> unit val _stdin : unit -> unit val _strict_sequence : unit -> unit val _trans_mod : unit -> unit val _unsafe : unit -> unit + val _unsafe_string : unit -> unit val _version : unit -> unit val _vnum : unit -> unit val _w : string -> unit @@ -719,11 +735,13 @@ struct mk_principal F._principal; mk_rectypes F._rectypes; mk_runtime_variant F._runtime_variant; + mk_safe_string F._safe_string; mk_short_paths F._short_paths; mk_strict_sequence F._strict_sequence; mk_trans_mod F._trans_mod; mk_thread F._thread; mk_unsafe F._unsafe; + mk_unsafe_string F._unsafe_string; mk_use_runtime F._use_runtime; mk_use_runtime_2 F._use_runtime; mk_v F._v; @@ -765,11 +783,13 @@ struct mk_ppx F._ppx; mk_principal F._principal; mk_rectypes F._rectypes; + mk_safe_string F._safe_string; mk_short_paths F._short_paths; mk_stdin F._stdin; mk_strict_sequence F._strict_sequence; mk_trans_mod F._trans_mod; mk_unsafe F._unsafe; + mk_unsafe_string F._unsafe_string; mk_version F._version; mk_vnum F._vnum; mk_w F._w; @@ -828,12 +848,14 @@ struct mk_rectypes F._rectypes; mk_runtime_variant F._runtime_variant; mk_S F._S; + mk_safe_string F._safe_string; mk_shared F._shared; mk_short_paths F._short_paths; mk_strict_sequence F._strict_sequence; mk_trans_mod F._trans_mod; mk_thread F._thread; mk_unsafe F._unsafe; + mk_unsafe_string F._unsafe_string; mk_v F._v; mk_verbose F._verbose; mk_version F._version; @@ -887,11 +909,13 @@ module Make_opttop_options (F : Opttop_options) = struct mk_principal F._principal; mk_rectypes F._rectypes; mk_S F._S; + mk_safe_string F._safe_string; mk_short_paths F._short_paths; mk_stdin F._stdin; mk_strict_sequence F._strict_sequence; mk_trans_mod F._trans_mod; mk_unsafe F._unsafe; + mk_unsafe_string F._unsafe_string; mk_version F._version; mk_vnum F._vnum; mk_w F._w; diff --git a/driver/main_args.mli b/driver/main_args.mli index 7d957d0095..98d294f87d 100644 --- a/driver/main_args.mli +++ b/driver/main_args.mli @@ -48,12 +48,14 @@ module type Bytecomp_options = val _principal : unit -> unit val _rectypes : unit -> unit val _runtime_variant : string -> unit + val _safe_string : unit -> unit val _short_paths : unit -> unit val _strict_sequence : unit -> unit val _trans_mod : unit -> unit val _thread : unit -> unit val _vmthread : unit -> unit val _unsafe : unit -> unit + val _unsafe_string : unit -> unit val _use_runtime : string -> unit val _v : unit -> unit val _version : unit -> unit @@ -92,11 +94,13 @@ module type Bytetop_options = sig val _ppx : string -> unit val _principal : unit -> unit val _rectypes : unit -> unit + val _safe_string : unit -> unit val _short_paths : unit -> unit val _stdin : unit -> unit val _strict_sequence : unit -> unit val _trans_mod : unit -> unit val _unsafe : unit -> unit + val _unsafe_string : unit -> unit val _version : unit -> unit val _vnum : unit -> unit val _w : string -> unit @@ -152,12 +156,14 @@ module type Optcomp_options = sig val _rectypes : unit -> unit val _runtime_variant : string -> unit val _S : unit -> unit + val _safe_string : unit -> unit val _shared : unit -> unit val _short_paths : unit -> unit val _strict_sequence : unit -> unit val _trans_mod : unit -> unit val _thread : unit -> unit val _unsafe : unit -> unit + val _unsafe_string : unit -> unit val _v : unit -> unit val _verbose : unit -> unit val _version : unit -> unit @@ -210,11 +216,13 @@ module type Opttop_options = sig val _principal : unit -> unit val _rectypes : unit -> unit val _S : unit -> unit + val _safe_string : unit -> unit val _short_paths : unit -> unit val _stdin : unit -> unit val _strict_sequence : unit -> unit val _trans_mod : unit -> unit val _unsafe : unit -> unit + val _unsafe_string : unit -> unit val _version : unit -> unit val _vnum : unit -> unit val _w : string -> unit diff --git a/driver/optmain.ml b/driver/optmain.ml index c8060b6a91..8285c6deb7 100644 --- a/driver/optmain.ml +++ b/driver/optmain.ml @@ -109,6 +109,7 @@ module Options = Main_args.Make_optcomp_options (struct let _principal = set principal let _rectypes = set recursive_types let _runtime_variant s = runtime_variant := s + let _safe_string = clear unsafe_string let _short_paths = clear real_paths let _strict_sequence = set strict_sequence let _trans_mod = set transparent_modules @@ -116,6 +117,7 @@ module Options = Main_args.Make_optcomp_options (struct let _S = set keep_asm_file let _thread = set use_threads let _unsafe = set fast + let _unsafe_string = set unsafe_string let _v () = print_version_and_library "native-code compiler" let _version () = print_version_string () let _vnum () = print_version_string () @@ -174,7 +176,8 @@ let main () = else if !make_package then begin Compmisc.init_path true; let target = extract_output !output_name in - Asmpackager.package_files ppf (get_objfiles ()) target; + Asmpackager.package_files ppf (Compmisc.initial_env ()) + (get_objfiles ()) target; Warnings.check_fatal (); end else if !shared then begin diff --git a/driver/pparse.ml b/driver/pparse.ml index 7f9974da7a..9912b3ad09 100644 --- a/driver/pparse.ml +++ b/driver/pparse.ml @@ -64,7 +64,7 @@ let apply_rewriter magic fn_in ppx = (* check magic before passing to the next ppx *) let ic = open_in_bin fn_out in let buffer = - try Misc.input_bytes ic (String.length magic) with End_of_file -> "" in + try really_input_string ic (String.length magic) with End_of_file -> "" in close_in ic; if buffer <> magic then begin Misc.remove_file fn_out; @@ -75,7 +75,7 @@ let apply_rewriter magic fn_in ppx = let read_ast magic fn = let ic = open_in_bin fn in try - let buffer = Misc.input_bytes ic (String.length magic) in + let buffer = really_input_string ic (String.length magic) in assert(buffer = magic); (* already checked by apply_rewriter *) Location.input_name := input_value ic; let ast = input_value ic in @@ -105,7 +105,7 @@ let file ppf inputfile parse_fun ast_magic = let ic = open_in_bin inputfile in let is_ast_file = try - let buffer = Misc.input_bytes ic (String.length ast_magic) in + let buffer = really_input_string ic (String.length ast_magic) in if buffer = ast_magic then true else if String.sub buffer 0 9 = String.sub ast_magic 0 9 then raise Outdated_version |