diff --git a/Changes b/Changes index 66becb5e8..0447629e4 100644 --- a/Changes +++ b/Changes @@ -90,6 +90,10 @@ Working version - GPR#1986, MPR#6450: Add Set.disjoint (Nicolás Ojeda Bär, review by Gabriel Scherer) +* GPR#1605: Deprecate Stdlib.Pervasives. Following #1010, Pervasives + is no longer needed and Stdlib should be used instead. + (Jérémie Dimino, review by Nicolás Ojeda Bär) + ### Other libraries: - GPR#1061: Add ?follow parameter to Unix.link. This allows hardlinking diff --git a/asmcomp/CSEgen.ml b/asmcomp/CSEgen.ml index d0b6eb2a4..09ecca70a 100644 --- a/asmcomp/CSEgen.ml +++ b/asmcomp/CSEgen.ml @@ -37,7 +37,7 @@ type rhs = operation * valnum array module Equations = struct module Rhs_map = - Map.Make(struct type t = rhs let compare = Pervasives.compare end) + Map.Make(struct type t = rhs let compare = Stdlib.compare end) type 'a t = { load_equations : 'a Rhs_map.t; diff --git a/asmcomp/clambda.ml b/asmcomp/clambda.ml index dc0d5fd3b..7fdec7d36 100644 --- a/asmcomp/clambda.ml +++ b/asmcomp/clambda.ml @@ -112,7 +112,7 @@ type preallocated_constant = { definition : ustructured_constant; } -(* Comparison functions for constants. We must not use Pervasives.compare +(* Comparison functions for constants. We must not use Stdlib.compare because it compares "0.0" and "-0.0" equal. (PR#6442) *) let compare_floats x1 x2 = @@ -134,8 +134,8 @@ let compare_constants c1 c2 = Different labels -> different constants, even if the contents match, because of string constants that must not be reshared. *) - | Uconst_int n1, Uconst_int n2 -> Pervasives.compare n1 n2 - | Uconst_ptr n1, Uconst_ptr n2 -> Pervasives.compare n1 n2 + | Uconst_int n1, Uconst_int n2 -> Stdlib.compare n1 n2 + | Uconst_ptr n1, Uconst_ptr n2 -> Stdlib.compare n1 n2 | Uconst_ref _, _ -> -1 | Uconst_int _, Uconst_ref _ -> 1 | Uconst_int _, Uconst_ptr _ -> -1 diff --git a/asmcomp/closure.ml b/asmcomp/closure.ml index 1fd362def..906129386 100644 --- a/asmcomp/closure.ml +++ b/asmcomp/closure.ml @@ -29,7 +29,7 @@ module Storer = type t = lambda type key = lambda let make_key = Lambda.make_key - let compare_key = Pervasives.compare + let compare_key = Stdlib.compare end) (* Auxiliaries for compiling functions *) diff --git a/asmcomp/cmmgen.ml b/asmcomp/cmmgen.ml index 3c2d0599e..aa049d732 100644 --- a/asmcomp/cmmgen.ml +++ b/asmcomp/cmmgen.ml @@ -1501,7 +1501,7 @@ module StoreExpForSwitch = let compare_key (cont, index) (cont', index') = match cont, cont' with | Some i, Some i' when i = i' -> 0 - | _, _ -> Pervasives.compare index index' + | _, _ -> Stdlib.compare index index' end) (* For string switches, we can use a generic store *) @@ -1513,7 +1513,7 @@ module StoreExp = let make_key = function | Cexit (i,[]) -> Some i | _ -> None - let compare_key = Pervasives.compare + let compare_key = Stdlib.compare end) module SwitcherBlocks = Switch.Make(SArgBlocks) diff --git a/asmcomp/compilenv.ml b/asmcomp/compilenv.ml index 0eb7eab2e..0a3860221 100644 --- a/asmcomp/compilenv.ml +++ b/asmcomp/compilenv.ml @@ -46,7 +46,7 @@ module CstMap = Map.Make(struct type t = Clambda.ustructured_constant let compare = Clambda.compare_structured_constants - (* PR#6442: it is incorrect to use Pervasives.compare on values of type t + (* PR#6442: it is incorrect to use Stdlib.compare on values of type t because it compares "0.0" and "-0.0" equal. *) end) diff --git a/asmcomp/debug/reg_with_debug_info.ml b/asmcomp/debug/reg_with_debug_info.ml index e6ff83610..24f7ac313 100644 --- a/asmcomp/debug/reg_with_debug_info.ml +++ b/asmcomp/debug/reg_with_debug_info.ml @@ -27,7 +27,7 @@ module Debug_info = struct let c = Ident.compare t1.holds_value_of t2.holds_value_of in if c <> 0 then c else - Pervasives.compare + Stdlib.compare (t1.part_of_value, t1.num_parts_of_value, t1.which_parameter) (t2.part_of_value, t2.num_parts_of_value, t2.which_parameter) @@ -142,7 +142,7 @@ module Order_distinguishing_names_and_locations = struct | Some di1, Some di2 -> let c = Ident.compare di1.holds_value_of di2.holds_value_of in if c <> 0 then c - else Pervasives.compare t1.reg.loc t2.reg.loc + else Stdlib.compare t1.reg.loc t2.reg.loc end module Set_distinguishing_names_and_locations = diff --git a/bytecomp/bytegen.ml b/bytecomp/bytegen.ml index d0d46de85..567a6cefb 100644 --- a/bytecomp/bytegen.ml +++ b/bytecomp/bytegen.ml @@ -445,7 +445,7 @@ let is_immed n = immed_min <= n && n <= immed_max module Storer = Switch.Store (struct type t = lambda type key = lambda - let compare_key = Pervasives.compare + let compare_key = Stdlib.compare let make_key = Lambda.make_key end) (* Compile an expression. diff --git a/bytecomp/lambda.ml b/bytecomp/lambda.ml index e9c476249..77c865abc 100644 --- a/bytecomp/lambda.ml +++ b/bytecomp/lambda.ml @@ -345,7 +345,7 @@ let default_stub_attribute = (* Build sharing keys *) (* - Those keys are later compared with Pervasives.compare. + Those keys are later compared with Stdlib.compare. For that reason, they should not include cycles. *) diff --git a/bytecomp/matching.ml b/bytecomp/matching.ml index 54bb7e2d0..722d23a3c 100644 --- a/bytecomp/matching.ml +++ b/bytecomp/matching.ml @@ -474,7 +474,7 @@ module StoreExp = (struct type t = lambda type key = lambda - let compare_key = Pervasives.compare + let compare_key = Stdlib.compare let make_key = Lambda.make_key end) diff --git a/debugger/input_handling.ml b/debugger/input_handling.ml index e69c5f4b9..b043629bd 100644 --- a/debugger/input_handling.ml +++ b/debugger/input_handling.ml @@ -110,7 +110,7 @@ let resume_user_input () = if not (List.mem_assoc !user_channel.io_fd !active_files) then begin if !interactif && !Parameters.prompt then begin print_string !current_prompt; - flush Pervasives.stdout + flush Stdlib.stdout end; add_file !user_channel exit_main_loop end diff --git a/debugger/program_management.ml b/debugger/program_management.ml index c8d81e434..0f4ae5a3f 100644 --- a/debugger/program_management.ml +++ b/debugger/program_management.ml @@ -119,7 +119,7 @@ let ask_kill_program () = let initialize_loading () = if !debug_loading then begin prerr_endline "Loading debugging information..."; - Printf.fprintf Pervasives.stderr "\tProgram: [%s]\n%!" !program_name; + Printf.fprintf Stdlib.stderr "\tProgram: [%s]\n%!" !program_name; end; begin try access !program_name [F_OK] with Unix_error _ -> @@ -141,7 +141,7 @@ let initialize_loading () = let ensure_loaded () = if not !loaded then begin print_string "Loading program... "; - flush Pervasives.stdout; + flush Stdlib.stdout; if !program_name = "" then begin prerr_endline "No program specified."; raise Toplevel diff --git a/debugger/unix_tools.ml b/debugger/unix_tools.ml index 4771253b0..e9e3f85c1 100644 --- a/debugger/unix_tools.ml +++ b/debugger/unix_tools.ml @@ -16,6 +16,7 @@ (****************** Tools for Unix *************************************) +module Real_stdlib = Stdlib open Misc open Unix @@ -58,7 +59,7 @@ let report_error = function (* Return the full path if found. *) (* Raise `Not_found' otherwise. *) let search_in_path name = - Printf.fprintf Pervasives.stderr "search_in_path [%s]\n%!" name; + Printf.fprintf Real_stdlib.stderr "search_in_path [%s]\n%!" name; let check name = try access name [X_OK]; name with Unix_error _ -> raise Not_found in diff --git a/lex/common.ml b/lex/common.ml index 5024c829f..82f74edaf 100644 --- a/lex/common.ml +++ b/lex/common.ml @@ -135,7 +135,7 @@ let output_env ic oc tr env = let env = List.sort (fun ((_,p1),_) ((_,p2),_) -> - Pervasives.compare p1.start_pos p2.start_pos) + Stdlib.compare p1.start_pos p2.start_pos) env in List.iter diff --git a/lex/lexgen.ml b/lex/lexgen.ml index ac3751cdf..184a8066a 100644 --- a/lex/lexgen.ml +++ b/lex/lexgen.ml @@ -85,7 +85,7 @@ module Ints = let id_compare (id1,_) (id2,_) = String.compare id1 id2 -let tag_compare t1 t2 = Pervasives.compare t1 t2 +let tag_compare t1 t2 = Stdlib.compare t1 t2 module Tags = Set.Make(struct type t = tag_info let compare = tag_compare end) @@ -528,7 +528,7 @@ type t_transition = type transition = t_transition * Tags.t let trans_compare (t1,tags1) (t2,tags2) = - match Pervasives.compare t1 t2 with + match Stdlib.compare t1 t2 with | 0 -> Tags.compare tags1 tags2 | r -> r @@ -606,12 +606,12 @@ let followpos size entry_list = let no_action = max_int module StateSet = - Set.Make (struct type t = t_transition let compare = Pervasives.compare end) + Set.Make (struct type t = t_transition let compare = Stdlib.compare end) module MemMap = Map.Make (struct type t = int - let compare (x:t) y = Pervasives.compare x y end) + let compare (x:t) y = Stdlib.compare x y end) type 'a dfa_state = {final : int * ('a * int TagMap.t) ; @@ -672,7 +672,7 @@ module MemKey = (struct type t = t_equiv - let compare e1 e2 = match Pervasives.compare e1.tag e2.tag with + let compare e1 e2 = match Stdlib.compare e1.tag e2.tag with | 0 -> StateSetSet.compare e1.equiv e2.equiv | r -> r end) diff --git a/middle_end/flambda_utils.ml b/middle_end/flambda_utils.ml index 6acf4a4c9..c70943765 100644 --- a/middle_end/flambda_utils.ml +++ b/middle_end/flambda_utils.ml @@ -804,7 +804,7 @@ module Switch_storer = Switch.Store (struct | Expr _, Prim _ -> -1 | Prim _, Expr _ -> 1 | Prim (prim1, args1), Prim (prim2, args2) -> - let comp_prim = Pervasives.compare prim1 prim2 in + let comp_prim = Stdlib.compare prim1 prim2 in if comp_prim <> 0 then comp_prim else Misc.Stdlib.List.compare (compare_var env) args1 args2 in diff --git a/middle_end/middle_end.ml b/middle_end/middle_end.ml index 2d3e5ffc2..50142baed 100644 --- a/middle_end/middle_end.ml +++ b/middle_end/middle_end.ml @@ -41,7 +41,7 @@ let middle_end ~ppf_dump ~prefixname ~backend let module WarningSet = Set.Make (struct type t = Location.t * Warnings.t - let compare = Pervasives.compare + let compare = Stdlib.compare end) in let warning_set = ref WarningSet.empty in diff --git a/ocamldoc/Makefile b/ocamldoc/Makefile index 3d71ba7fa..aae4f5bd4 100644 --- a/ocamldoc/Makefile +++ b/ocamldoc/Makefile @@ -403,15 +403,13 @@ stdlib_man/Pervasives.3o: $(OCAMLDOC) $(STDLIB_MLIS) $(MAKE) unprefix_stdlib_for_ocamldoc $(MKDIR) stdlib_man $(OCAMLDOC_RUN) -man -d stdlib_man -nostdlib -I stdlib_non_prefixed \ - -t "OCaml library" -man-mini $(STDLIB_MLIS) \ - -initially-opened-module Pervasives + -t "OCaml library" -man-mini $(STDLIB_MLIS) stdlib_html/Pervasives.html: $(OCAMLDOC) $(STDLIB_MLIS) $(MAKE) unprefix_stdlib_for_ocamldoc $(MKDIR) stdlib_html $(OCAMLDOC_RUN) -d stdlib_html -html -nostdlib -I stdlib_non_prefixed \ - -t "OCaml library" $(STDLIB_MLIS) \ - -initially-opened-module Pervasives + -t "OCaml library" $(STDLIB_MLIS) .PHONY: autotest_stdlib autotest_stdlib: diff --git a/ocamldoc/Makefile.unprefix b/ocamldoc/Makefile.unprefix index ef362a90c..3db897ca7 100644 --- a/ocamldoc/Makefile.unprefix +++ b/ocamldoc/Makefile.unprefix @@ -21,7 +21,6 @@ include $(SRC)/stdlib/StdlibModules STDLIB_UNPREFIXED=$(SRC)/ocamldoc/stdlib_non_prefixed -STDLIB_MODULES := pervasives $(filter-out stdlib,$(STDLIB_MODULES)) PARSING_MLIS := $(wildcard $(SRC)/parsing/*.mli) UTILS_MLIS := $(wildcard $(SRC)/utils/*.mli) TYPING_MLIS := $(wildcard $(SRC)/typing/*.mli) @@ -59,6 +58,10 @@ STDLIB_CMIS=$(STDLIB_DEPS:%.mli=%.cmi) $(STDLIB_UNPREFIXED)/%.mli: $(SRC)/stdlib/%.mli cp $< $@ +$(STDLIB_UNPREFIXED)/pervasives.mli: + echo '[@@@deprecated "Use Stdlib instead."]' > $@ + echo 'include module type of struct include Stdlib end' >> $@ + $(STDLIB_UNPREFIXED)/%.mli: $(SRC)/parsing/%.mli cp $< $@ @@ -92,10 +95,10 @@ $(STDLIB_UNPREFIXED)/%.mli: $(SRC)/typing/%.mli $(STDLIB_UNPREFIXED)/%.mli: $(SRC)/bytecomp/%.mli cp $< $@ -#Extract the pervasives module from stdlib.mli -$(STDLIB_UNPREFIXED)/pervasives.mli: $(SRC)/stdlib/stdlib.mli \ - $(STDLIB_UNPREFIXED)/extract_pervasives.awk - $(AWK) -f $(STDLIB_UNPREFIXED)/extract_pervasives.awk $< > $@ +# Remove aliases from stdlib.mli +$(STDLIB_UNPREFIXED)/stdlib.mli: $(SRC)/stdlib/stdlib.mli \ + $(SRC)/stdlib/remove_module_aliases.awk + $(AWK) -f $(SRC)/stdlib/remove_module_aliases.awk $< > $@ # Build cmis file inside the STDLIB_UNPREFIXED directories .PHONY: unprefix_stdlib_for_ocamldoc diff --git a/ocamldoc/odoc_cross.ml b/ocamldoc/odoc_cross.ml index 9dd6aee0f..e688a8ad5 100644 --- a/ocamldoc/odoc_cross.ml +++ b/ocamldoc/odoc_cross.ml @@ -31,7 +31,7 @@ open Odoc_parameter module S = Set.Make ( struct type t = string * ref_kind option - let compare = Pervasives.compare + let compare = Stdlib.compare end ) diff --git a/ocamldoc/odoc_merge.ml b/ocamldoc/odoc_merge.ml index 7f9434db2..f11ab5da0 100644 --- a/ocamldoc/odoc_merge.ml +++ b/ocamldoc/odoc_merge.ml @@ -117,7 +117,7 @@ let merge_info merge_options (m1 : info) (m2 : info) = else l1 in let new_before = List.map (fun (v, t) -> (Str.split version_separators v, v, t)) new_before in - let new_before = List.sort Pervasives.compare new_before in + let new_before = List.sort Stdlib.compare new_before in let new_before = List.map (fun (_, v, t) -> (v, t)) new_before in let new_dep = match m1.i_deprecated, m2.i_deprecated with diff --git a/ocamldoc/stdlib_non_prefixed/.depend b/ocamldoc/stdlib_non_prefixed/.depend index 23493b387..5c31991a0 100644 --- a/ocamldoc/stdlib_non_prefixed/.depend +++ b/ocamldoc/stdlib_non_prefixed/.depend @@ -55,8 +55,8 @@ envaux.cmi : subst.cmi path.cmi format.cmi env.cmi ephemeron.cmi : hashtbl.cmi event.cmi : filename.cmi : -float.cmi : pervasives.cmi -format.cmi : pervasives.cmi buffer.cmi +float.cmi : stdlib.cmi +format.cmi : stdlib.cmi buffer.cmi gc.cmi : genlex.cmi : stream.cmi graphics.cmi : @@ -85,7 +85,7 @@ map.cmi : seq.cmi marshal.cmi : matching.cmi : typedtree.cmi location.cmi lambda.cmi ident.cmi meta.cmi : obj.cmi instruct.cmi -misc.cmi : string.cmi set.cmi map.cmi hashtbl.cmi format.cmi \ +misc.cmi : string.cmi stdlib.cmi set.cmi map.cmi hashtbl.cmi format.cmi \ build_path_prefix_map.cmi moreLabels.cmi : set.cmi seq.cmi map.cmi hashtbl.cmi mtype.cmi : types.cmi path.cmi ident.cmi env.cmi @@ -104,7 +104,7 @@ parser.cmi : parsetree.cmi location.cmi lexing.cmi docstrings.cmi parsetree.cmi : longident.cmi location.cmi asttypes.cmi parsing.cmi : obj.cmi lexing.cmi path.cmi : set.cmi map.cmi ident.cmi -pervasives.cmi : camlinternalFormatBasics.cmi +pervasives.cmi : stdlib.cmi pparse.cmi : parsetree.cmi misc.cmi lexing.cmi format.cmi pprintast.cmi : parsetree.cmi format.cmi predef.cmi : types.cmi path.cmi ident.cmi @@ -124,7 +124,7 @@ random.cmi : nativeint.cmi int64.cmi int32.cmi rec_check.cmi : typedtree.cmi ident.cmi result.cmi : seq.cmi runtimedef.cmi : -scanf.cmi : pervasives.cmi +scanf.cmi : stdlib.cmi semantics_of_primitives.cmi : lambda.cmi seq.cmi : set.cmi : seq.cmi @@ -133,6 +133,7 @@ spacetime.cmi : stack.cmi : seq.cmi stdLabels.cmi : stringLabels.cmi listLabels.cmi bytesLabels.cmi \ arrayLabels.cmi +stdlib.cmi : camlinternalFormatBasics.cmi str.cmi : stream.cmi : string.cmi : seq.cmi diff --git a/ocamldoc/stdlib_non_prefixed/Makefile b/ocamldoc/stdlib_non_prefixed/Makefile index e967dfb90..3d8a13b72 100644 --- a/ocamldoc/stdlib_non_prefixed/Makefile +++ b/ocamldoc/stdlib_non_prefixed/Makefile @@ -18,17 +18,17 @@ include $(TOPDIR)/Makefile.tools .SUFFIXES: OCAMLDEP= $(OCAMLRUN) $(TOPDIR)/tools/ocamldep -slash -OCAMLC_SNP= $(OCAMLRUN) $(TOPDIR)/ocamlc -nostdlib -nopervasives +OCAMLC_SNP= $(OCAMLRUN) $(TOPDIR)/ocamlc -nostdlib -I . -pervasives.cmi: pervasives.mli camlinternalFormatBasics.cmi - $(OCAMLC_SNP) -c $< +stdlib.cmi: stdlib.mli camlinternalFormatBasics.cmi + $(OCAMLC_SNP) -nopervasives -c $< camlinternalFormatBasics.cmi: \ camlinternalFormatBasics.mli - $(OCAMLC_SNP) -c $< + $(OCAMLC_SNP) -nopervasives -c $< -%.cmi: %.mli pervasives.cmi - $(OCAMLC_SNP) -c -open Pervasives $< +%.cmi: %.mli stdlib.cmi + $(OCAMLC_SNP) -c $< depend: $(OCAMLDEP) *.mli > .depend diff --git a/ocamldoc/stdlib_non_prefixed/extract_pervasives.awk b/ocamldoc/stdlib_non_prefixed/extract_pervasives.awk index e0f7f8720..c68df420d 100644 --- a/ocamldoc/stdlib_non_prefixed/extract_pervasives.awk +++ b/ocamldoc/stdlib_non_prefixed/extract_pervasives.awk @@ -15,9 +15,7 @@ # This script extract the Pervasives submodule from stdlib.mli into # pervasives.mli, for ocamldoc BEGIN { state=0 } -/^module Pervasives : sig\r?$/ && state == 0 { state=1 } -/^end\r?$/ && state == 2 { state=3 } +/^\(\*MODULE_ALIASES\*\)\r?$/ && state == 0 { state=1 } { - if (state == 1) state=2; - else if (state == 2) print + if (state == 0) print } diff --git a/ocamltest/filecompare.ml b/ocamltest/filecompare.ml index e1e9c03f3..f9a596096 100644 --- a/ocamltest/filecompare.ml +++ b/ocamltest/filecompare.ml @@ -88,7 +88,7 @@ let compare_text_files dropped_lines file1 file2 = else Different -(* Version of Pervasives.really_input which stops at EOF, rather than raising +(* Version of Stdlib.really_input which stops at EOF, rather than raising an exception. *) let really_input_up_to ic = let block_size = 8192 in @@ -174,7 +174,7 @@ let diff files = "> " ^ temporary_file ] in let result = - if (Sys.command diff_commandline) = 2 then Pervasives.Error "diff" + if (Sys.command diff_commandline) = 2 then Stdlib.Error "diff" else Ok (Sys.string_of_file temporary_file) in Sys.force_remove temporary_file; diff --git a/ocamltest/filecompare.mli b/ocamltest/filecompare.mli index b1cb8569a..42b493ae1 100644 --- a/ocamltest/filecompare.mli +++ b/ocamltest/filecompare.mli @@ -45,4 +45,4 @@ val check_file : ?tool:tool -> files -> result val cmp_result_of_exitcode : string -> int -> result -val diff : files -> (string, string) Pervasives.result +val diff : files -> (string, string) Stdlib.result diff --git a/ocamltest/ocaml_actions.ml b/ocamltest/ocaml_actions.ml index cf7cd4951..b9dcbd03f 100644 --- a/ocamltest/ocaml_actions.ml +++ b/ocamltest/ocaml_actions.ml @@ -1268,7 +1268,7 @@ let run_ocamldoc = let load_all = List.map (fun name -> "-load " ^ compiled_doc_name (fst name)) @@ (* sort module in alphabetical order *) - List.sort Pervasives.compare modules in + List.sort Stdlib.compare modules in let with_plugins = List.map (fun name -> "-g " ^ ocamldoc_plugin (fst name)) plugins in let commandline = diff --git a/otherlibs/threads/scheduler.c b/otherlibs/threads/scheduler.c index f434dc49c..7a69bfcaa 100644 --- a/otherlibs/threads/scheduler.c +++ b/otherlibs/threads/scheduler.c @@ -569,7 +569,7 @@ value thread_sleep(value unit) /* ML */ static value thread_wait_rw(int kind, value fd) { /* Don't do an error if we're not initialized yet - (we can be called from thread-safe Pervasives before initialization), + (we can be called from thread-safe Stdlib before initialization), just return immediately. */ if (curr_thread == NULL) return RESUMED_WAKEUP; /* As a special case, if we're in a callback, don't fail but block diff --git a/otherlibs/threads/stdlib.ml b/otherlibs/threads/stdlib.ml index b4e6d7570..27cb01e54 100644 --- a/otherlibs/threads/stdlib.ml +++ b/otherlibs/threads/stdlib.ml @@ -17,7 +17,6 @@ been redefined to not block the whole process, but only the calling thread. *) -module Pervasives = struct (* type 'a option = None | Some of 'a *) (* Exceptions *) @@ -654,9 +653,6 @@ let exit retcode = sys_exit retcode let _ = register_named_value "Pervasives.do_at_exit" do_at_exit -end - -include Pervasives (*MODULE_ALIASES*) module Arg = Arg @@ -691,6 +687,7 @@ module Obj = Obj module Oo = Oo module Option = Option module Parsing = Parsing +module Pervasives = Pervasives module Printexc = Printexc module Printf = Printf module Queue = Queue diff --git a/otherlibs/unix/unix.mli b/otherlibs/unix/unix.mli index 78d60df70..bc709c49c 100644 --- a/otherlibs/unix/unix.mli +++ b/otherlibs/unix/unix.mli @@ -791,7 +791,7 @@ val open_process_out : string -> out_channel the command to a pipe. Data written to the returned output channel is sent to the standard input of the command. Warning: writes on output channels are buffered, hence be careful - to call {!Pervasives.flush} at the right times to ensure + to call {!Stdlib.flush} at the right times to ensure correct synchronization. *) val open_process : string -> in_channel * out_channel @@ -820,7 +820,7 @@ val open_process_args_out : string -> string array -> out_channel (** Same as {!Unix.open_process_args_in}, but redirect the standard input of the command to a pipe. Data written to the returned output channel is sent to the standard input of the command. Warning: writes on output channels are - buffered, hence be careful to call {!Pervasives.flush} at the right times to + buffered, hence be careful to call {!Stdlib.flush} at the right times to ensure correct synchronization. @since 4.08.0 *) @@ -1464,7 +1464,7 @@ val getsockopt_error : file_descr -> error option val open_connection : sockaddr -> in_channel * out_channel (** Connect to a server at the given address. Return a pair of buffered channels connected to the server. - Remember to call {!Pervasives.flush} on the output channel at the right + Remember to call {!Stdlib.flush} on the output channel at the right times to ensure correct synchronization. *) val shutdown_connection : in_channel -> unit @@ -1472,7 +1472,7 @@ val shutdown_connection : in_channel -> unit that is, transmit an end-of-file condition to the server reading on the other side of the connection. This does not fully close the file descriptor associated with the channel, which you must remember - to free via {!Pervasives.close_in}. *) + to free via {!Stdlib.close_in}. *) val establish_server : (in_channel -> out_channel -> unit) -> sockaddr -> unit (** Establish a server on the given address. diff --git a/otherlibs/unix/unixLabels.mli b/otherlibs/unix/unixLabels.mli index 523ab91be..8ae927909 100644 --- a/otherlibs/unix/unixLabels.mli +++ b/otherlibs/unix/unixLabels.mli @@ -660,7 +660,7 @@ val open_process_out : string -> out_channel the command to a pipe. Data written to the returned output channel is sent to the standard input of the command. Warning: writes on output channels are buffered, hence be careful - to call {!Pervasives.flush} at the right times to ensure + to call {!Stdlib.flush} at the right times to ensure correct synchronization. *) val open_process : string -> in_channel * out_channel @@ -689,7 +689,7 @@ val open_process_args_out : string -> string array -> out_channel (** Same as {!Unix.open_process_args_in}, but redirect the standard input of the command to a pipe. Data written to the returned output channel is sent to the standard input of the command. Warning: writes on output channels are - buffered, hence be careful to call {!Pervasives.flush} at the right times to + buffered, hence be careful to call {!Stdlib.flush} at the right times to ensure correct synchronization. @since 4.08.0 *) @@ -1252,7 +1252,7 @@ val getsockopt_error : file_descr -> error option val open_connection : sockaddr -> in_channel * out_channel (** Connect to a server at the given address. Return a pair of buffered channels connected to the server. - Remember to call {!Pervasives.flush} on the output channel at the right + Remember to call {!Stdlib.flush} on the output channel at the right times to ensure correct synchronization. *) val shutdown_connection : in_channel -> unit diff --git a/stdlib/.depend b/stdlib/.depend index 3be3711d8..dc8062261 100644 --- a/stdlib/.depend +++ b/stdlib/.depend @@ -17,8 +17,8 @@ stdlib__buffer.cmo : stdlib__uchar.cmi stdlib__sys.cmi stdlib__string.cmi stdlib stdlib__buffer.cmx : stdlib__uchar.cmx stdlib__sys.cmx stdlib__string.cmx stdlib__seq.cmx stdlib__char.cmx stdlib__bytes.cmx \ stdlib__buffer.cmi stdlib__buffer.cmi : stdlib__uchar.cmi stdlib__seq.cmi -stdlib__bytes.cmo : stdlib__sys.cmi stdlib__seq.cmi stdlib__char.cmi stdlib__bytes.cmi -stdlib__bytes.cmx : stdlib__sys.cmx stdlib__seq.cmx stdlib__char.cmx stdlib__bytes.cmi +stdlib__bytes.cmo : stdlib__sys.cmi stdlib.cmi stdlib__seq.cmi stdlib__char.cmi stdlib__bytes.cmi +stdlib__bytes.cmx : stdlib__sys.cmx stdlib.cmx stdlib__seq.cmx stdlib__char.cmx stdlib__bytes.cmi stdlib__bytes.cmi : stdlib__seq.cmi stdlib__bytesLabels.cmo : stdlib__bytes.cmi stdlib__bytesLabels.cmi stdlib__bytesLabels.cmx : stdlib__bytes.cmx stdlib__bytesLabels.cmi @@ -66,14 +66,14 @@ stdlib__filename.cmo : stdlib__sys.cmi stdlib__string.cmi stdlib__random.cmi std stdlib__filename.cmx : stdlib__sys.cmx stdlib__string.cmx stdlib__random.cmx stdlib__printf.cmx stdlib__lazy.cmx stdlib__buffer.cmx \ stdlib__filename.cmi stdlib__filename.cmi : -stdlib__float.cmo : stdlib__float.cmi -stdlib__float.cmx : stdlib__float.cmi -stdlib__float.cmi : -stdlib__format.cmo : stdlib__string.cmi stdlib__stack.cmi stdlib__queue.cmi stdlib__list.cmi \ +stdlib__float.cmo : stdlib.cmi stdlib__float.cmi +stdlib__float.cmx : stdlib.cmx stdlib__float.cmi +stdlib__float.cmi : stdlib.cmi +stdlib__format.cmo : stdlib__string.cmi stdlib.cmi stdlib__stack.cmi stdlib__queue.cmi stdlib__list.cmi \ camlinternalFormatBasics.cmi camlinternalFormat.cmi stdlib__buffer.cmi stdlib__format.cmi -stdlib__format.cmx : stdlib__string.cmx stdlib__stack.cmx stdlib__queue.cmx stdlib__list.cmx \ +stdlib__format.cmx : stdlib__string.cmx stdlib.cmx stdlib__stack.cmx stdlib__queue.cmx stdlib__list.cmx \ camlinternalFormatBasics.cmx camlinternalFormat.cmx stdlib__buffer.cmx stdlib__format.cmi -stdlib__format.cmi : stdlib__buffer.cmi +stdlib__format.cmi : stdlib.cmi stdlib__buffer.cmi stdlib__gc.cmo : stdlib__sys.cmi stdlib__string.cmi stdlib__printf.cmi stdlib__gc.cmi stdlib__gc.cmx : stdlib__sys.cmx stdlib__string.cmx stdlib__printf.cmx stdlib__gc.cmi stdlib__gc.cmi : @@ -87,11 +87,11 @@ stdlib__hashtbl.cmo : stdlib__sys.cmi stdlib__string.cmi stdlib__seq.cmi stdlib_ stdlib__hashtbl.cmx : stdlib__sys.cmx stdlib__string.cmx stdlib__seq.cmx stdlib__random.cmx stdlib__obj.cmx stdlib__lazy.cmx \ stdlib__array.cmx stdlib__hashtbl.cmi stdlib__hashtbl.cmi : stdlib__seq.cmi -stdlib__int32.cmo : stdlib__int32.cmi -stdlib__int32.cmx : stdlib__int32.cmi +stdlib__int32.cmo : stdlib.cmi stdlib__int32.cmi +stdlib__int32.cmx : stdlib.cmx stdlib__int32.cmi stdlib__int32.cmi : -stdlib__int64.cmo : stdlib__int64.cmi -stdlib__int64.cmx : stdlib__int64.cmi +stdlib__int64.cmo : stdlib.cmi stdlib__int64.cmi +stdlib__int64.cmx : stdlib.cmx stdlib__int64.cmi stdlib__int64.cmi : stdlib__lazy.cmo : stdlib__obj.cmi camlinternalLazy.cmi stdlib__lazy.cmi stdlib__lazy.cmx : stdlib__obj.cmx camlinternalLazy.cmx stdlib__lazy.cmi @@ -114,8 +114,8 @@ stdlib__marshal.cmi : stdlib__moreLabels.cmo : stdlib__set.cmi stdlib__map.cmi stdlib__hashtbl.cmi stdlib__moreLabels.cmi stdlib__moreLabels.cmx : stdlib__set.cmx stdlib__map.cmx stdlib__hashtbl.cmx stdlib__moreLabels.cmi stdlib__moreLabels.cmi : stdlib__set.cmi stdlib__seq.cmi stdlib__map.cmi stdlib__hashtbl.cmi -stdlib__nativeint.cmo : stdlib__sys.cmi stdlib__nativeint.cmi -stdlib__nativeint.cmx : stdlib__sys.cmx stdlib__nativeint.cmi +stdlib__nativeint.cmo : stdlib__sys.cmi stdlib.cmi stdlib__nativeint.cmi +stdlib__nativeint.cmx : stdlib__sys.cmx stdlib.cmx stdlib__nativeint.cmi stdlib__nativeint.cmi : stdlib__obj.cmo : stdlib__marshal.cmi stdlib__int32.cmi stdlib__obj.cmi stdlib__obj.cmx : stdlib__marshal.cmx stdlib__int32.cmx stdlib__obj.cmi @@ -129,8 +129,12 @@ stdlib__option.cmi : stdlib__seq.cmi stdlib__parsing.cmo : stdlib__obj.cmi stdlib__lexing.cmi stdlib__array.cmi stdlib__parsing.cmi stdlib__parsing.cmx : stdlib__obj.cmx stdlib__lexing.cmx stdlib__array.cmx stdlib__parsing.cmi stdlib__parsing.cmi : stdlib__obj.cmi stdlib__lexing.cmi -stdlib__printexc.cmo : stdlib__printf.cmi stdlib__obj.cmi stdlib__buffer.cmi stdlib__array.cmi stdlib__printexc.cmi -stdlib__printexc.cmx : stdlib__printf.cmx stdlib__obj.cmx stdlib__buffer.cmx stdlib__array.cmx stdlib__printexc.cmi +stdlib__pervasives.cmo : camlinternalFormatBasics.cmi +stdlib__pervasives.cmx : camlinternalFormatBasics.cmx +stdlib__printexc.cmo : stdlib.cmi stdlib__printf.cmi stdlib__obj.cmi stdlib__buffer.cmi stdlib__array.cmi \ + stdlib__printexc.cmi +stdlib__printexc.cmx : stdlib.cmx stdlib__printf.cmx stdlib__obj.cmx stdlib__buffer.cmx stdlib__array.cmx \ + stdlib__printexc.cmi stdlib__printexc.cmi : stdlib__printf.cmo : camlinternalFormatBasics.cmi camlinternalFormat.cmi stdlib__buffer.cmi \ stdlib__printf.cmi @@ -140,19 +144,21 @@ stdlib__printf.cmi : stdlib__buffer.cmi stdlib__queue.cmo : stdlib__seq.cmi stdlib__queue.cmi stdlib__queue.cmx : stdlib__seq.cmx stdlib__queue.cmi stdlib__queue.cmi : stdlib__seq.cmi -stdlib__random.cmo : stdlib__string.cmi stdlib__nativeint.cmi stdlib__int64.cmi stdlib__int32.cmi stdlib__digest.cmi \ - stdlib__char.cmi stdlib__array.cmi stdlib__random.cmi -stdlib__random.cmx : stdlib__string.cmx stdlib__nativeint.cmx stdlib__int64.cmx stdlib__int32.cmx stdlib__digest.cmx \ - stdlib__char.cmx stdlib__array.cmx stdlib__random.cmi +stdlib__random.cmo : stdlib__string.cmi stdlib.cmi stdlib__nativeint.cmi stdlib__int64.cmi stdlib__int32.cmi \ + stdlib__digest.cmi stdlib__char.cmi stdlib__array.cmi stdlib__random.cmi +stdlib__random.cmx : stdlib__string.cmx stdlib.cmx stdlib__nativeint.cmx stdlib__int64.cmx stdlib__int32.cmx \ + stdlib__digest.cmx stdlib__char.cmx stdlib__array.cmx stdlib__random.cmi stdlib__random.cmi : stdlib__nativeint.cmi stdlib__int64.cmi stdlib__int32.cmi stdlib__result.cmo : stdlib__seq.cmi stdlib__result.cmi stdlib__result.cmx : stdlib__seq.cmx stdlib__result.cmi stdlib__result.cmi : stdlib__seq.cmi -stdlib__scanf.cmo : stdlib__string.cmi stdlib__printf.cmi stdlib__list.cmi camlinternalFormatBasics.cmi \ - camlinternalFormat.cmi stdlib__bytes.cmi stdlib__buffer.cmi stdlib__scanf.cmi -stdlib__scanf.cmx : stdlib__string.cmx stdlib__printf.cmx stdlib__list.cmx camlinternalFormatBasics.cmx \ - camlinternalFormat.cmx stdlib__bytes.cmx stdlib__buffer.cmx stdlib__scanf.cmi -stdlib__scanf.cmi : +stdlib__scanf.cmo : stdlib__string.cmi stdlib.cmi stdlib__printf.cmi stdlib__list.cmi \ + camlinternalFormatBasics.cmi camlinternalFormat.cmi stdlib__bytes.cmi stdlib__buffer.cmi \ + stdlib__scanf.cmi +stdlib__scanf.cmx : stdlib__string.cmx stdlib.cmx stdlib__printf.cmx stdlib__list.cmx \ + camlinternalFormatBasics.cmx camlinternalFormat.cmx stdlib__bytes.cmx stdlib__buffer.cmx \ + stdlib__scanf.cmi +stdlib__scanf.cmi : stdlib.cmi stdlib__seq.cmo : stdlib__seq.cmi stdlib__seq.cmx : stdlib__seq.cmi stdlib__seq.cmi : @@ -176,8 +182,8 @@ std_exit.cmx : stdlib__stream.cmo : stdlib__string.cmi stdlib__list.cmi stdlib__lazy.cmi stdlib__bytes.cmi stdlib__stream.cmi stdlib__stream.cmx : stdlib__string.cmx stdlib__list.cmx stdlib__lazy.cmx stdlib__bytes.cmx stdlib__stream.cmi stdlib__stream.cmi : -stdlib__string.cmo : stdlib__bytes.cmi stdlib__string.cmi -stdlib__string.cmx : stdlib__bytes.cmx stdlib__string.cmi +stdlib__string.cmo : stdlib.cmi stdlib__bytes.cmi stdlib__string.cmi +stdlib__string.cmx : stdlib.cmx stdlib__bytes.cmx stdlib__string.cmi stdlib__string.cmi : stdlib__seq.cmi stdlib__stringLabels.cmo : stdlib__string.cmi stdlib__stringLabels.cmi stdlib__stringLabels.cmx : stdlib__string.cmx stdlib__stringLabels.cmi @@ -185,8 +191,8 @@ stdlib__stringLabels.cmi : stdlib__seq.cmi stdlib__sys.cmo : stdlib__sys.cmi stdlib__sys.cmx : stdlib__sys.cmi stdlib__sys.cmi : -stdlib__uchar.cmo : stdlib__char.cmi stdlib__uchar.cmi -stdlib__uchar.cmx : stdlib__char.cmx stdlib__uchar.cmi +stdlib__uchar.cmo : stdlib.cmi stdlib__char.cmi stdlib__uchar.cmi +stdlib__uchar.cmx : stdlib.cmx stdlib__char.cmx stdlib__uchar.cmi stdlib__uchar.cmi : stdlib__weak.cmo : stdlib__sys.cmi stdlib__obj.cmi stdlib__hashtbl.cmi stdlib__array.cmi stdlib__weak.cmi stdlib__weak.cmx : stdlib__sys.cmx stdlib__obj.cmx stdlib__hashtbl.cmx stdlib__array.cmx stdlib__weak.cmi @@ -208,8 +214,8 @@ stdlib__buffer.cmo : stdlib__uchar.cmi stdlib__sys.cmi stdlib__string.cmi stdlib stdlib__buffer.cmi stdlib__buffer.p.cmx : stdlib__uchar.cmx stdlib__sys.cmx stdlib__string.cmx stdlib__seq.cmx stdlib__char.cmx stdlib__bytes.cmx \ stdlib__buffer.cmi -stdlib__bytes.cmo : stdlib__sys.cmi stdlib__seq.cmi stdlib__char.cmi stdlib__bytes.cmi -stdlib__bytes.p.cmx : stdlib__sys.cmx stdlib__seq.cmx stdlib__char.cmx stdlib__bytes.cmi +stdlib__bytes.cmo : stdlib__sys.cmi stdlib.cmi stdlib__seq.cmi stdlib__char.cmi stdlib__bytes.cmi +stdlib__bytes.p.cmx : stdlib__sys.cmx stdlib.cmx stdlib__seq.cmx stdlib__char.cmx stdlib__bytes.cmi stdlib__bytesLabels.cmo : stdlib__bytes.cmi stdlib__bytesLabels.cmi stdlib__bytesLabels.p.cmx : stdlib__bytes.cmx stdlib__bytesLabels.cmi stdlib__callback.cmo : stdlib__obj.cmi stdlib__callback.cmi @@ -244,11 +250,11 @@ stdlib__filename.cmo : stdlib__sys.cmi stdlib__string.cmi stdlib__random.cmi std stdlib__filename.cmi stdlib__filename.p.cmx : stdlib__sys.cmx stdlib__string.cmx stdlib__random.cmx stdlib__printf.cmx stdlib__lazy.cmx stdlib__buffer.cmx \ stdlib__filename.cmi -stdlib__float.cmo : stdlib__float.cmi -stdlib__float.p.cmx : stdlib__float.cmi -stdlib__format.cmo : stdlib__string.cmi stdlib__stack.cmi stdlib__queue.cmi stdlib__list.cmi \ +stdlib__float.cmo : stdlib.cmi stdlib__float.cmi +stdlib__float.p.cmx : stdlib.cmx stdlib__float.cmi +stdlib__format.cmo : stdlib__string.cmi stdlib.cmi stdlib__stack.cmi stdlib__queue.cmi stdlib__list.cmi \ camlinternalFormatBasics.cmi camlinternalFormat.cmi stdlib__buffer.cmi stdlib__format.cmi -stdlib__format.p.cmx : stdlib__string.cmx stdlib__stack.cmx stdlib__queue.cmx stdlib__list.cmx \ +stdlib__format.p.cmx : stdlib__string.cmx stdlib.cmx stdlib__stack.cmx stdlib__queue.cmx stdlib__list.cmx \ camlinternalFormatBasics.cmx camlinternalFormat.cmx stdlib__buffer.cmx stdlib__format.cmi stdlib__gc.cmo : stdlib__sys.cmi stdlib__string.cmi stdlib__printf.cmi stdlib__gc.cmi stdlib__gc.p.cmx : stdlib__sys.cmx stdlib__string.cmx stdlib__printf.cmx stdlib__gc.cmi @@ -260,10 +266,10 @@ stdlib__hashtbl.cmo : stdlib__sys.cmi stdlib__string.cmi stdlib__seq.cmi stdlib_ stdlib__array.cmi stdlib__hashtbl.cmi stdlib__hashtbl.p.cmx : stdlib__sys.cmx stdlib__string.cmx stdlib__seq.cmx stdlib__random.cmx stdlib__obj.cmx stdlib__lazy.cmx \ stdlib__array.cmx stdlib__hashtbl.cmi -stdlib__int32.cmo : stdlib__int32.cmi -stdlib__int32.p.cmx : stdlib__int32.cmi -stdlib__int64.cmo : stdlib__int64.cmi -stdlib__int64.p.cmx : stdlib__int64.cmi +stdlib__int32.cmo : stdlib.cmi stdlib__int32.cmi +stdlib__int32.p.cmx : stdlib.cmx stdlib__int32.cmi +stdlib__int64.cmo : stdlib.cmi stdlib__int64.cmi +stdlib__int64.p.cmx : stdlib.cmx stdlib__int64.cmi stdlib__lazy.cmo : stdlib__obj.cmi camlinternalLazy.cmi stdlib__lazy.cmi stdlib__lazy.p.cmx : stdlib__obj.cmx camlinternalLazy.cmx stdlib__lazy.cmi stdlib__lexing.cmo : stdlib__sys.cmi stdlib__string.cmi stdlib__bytes.cmi stdlib__array.cmi stdlib__lexing.cmi @@ -278,8 +284,8 @@ stdlib__marshal.cmo : stdlib__bytes.cmi stdlib__marshal.cmi stdlib__marshal.p.cmx : stdlib__bytes.cmx stdlib__marshal.cmi stdlib__moreLabels.cmo : stdlib__set.cmi stdlib__map.cmi stdlib__hashtbl.cmi stdlib__moreLabels.cmi stdlib__moreLabels.p.cmx : stdlib__set.cmx stdlib__map.cmx stdlib__hashtbl.cmx stdlib__moreLabels.cmi -stdlib__nativeint.cmo : stdlib__sys.cmi stdlib__nativeint.cmi -stdlib__nativeint.p.cmx : stdlib__sys.cmx stdlib__nativeint.cmi +stdlib__nativeint.cmo : stdlib__sys.cmi stdlib.cmi stdlib__nativeint.cmi +stdlib__nativeint.p.cmx : stdlib__sys.cmx stdlib.cmx stdlib__nativeint.cmi stdlib__obj.cmo : stdlib__marshal.cmi stdlib__int32.cmi stdlib__obj.cmi stdlib__obj.p.cmx : stdlib__marshal.cmx stdlib__int32.cmx stdlib__obj.cmi stdlib__oo.cmo : camlinternalOO.cmi stdlib__oo.cmi @@ -288,24 +294,30 @@ stdlib__option.cmo : stdlib__seq.cmi stdlib__option.cmi stdlib__option.p.cmx : stdlib__seq.cmx stdlib__option.cmi stdlib__parsing.cmo : stdlib__obj.cmi stdlib__lexing.cmi stdlib__array.cmi stdlib__parsing.cmi stdlib__parsing.p.cmx : stdlib__obj.cmx stdlib__lexing.cmx stdlib__array.cmx stdlib__parsing.cmi -stdlib__printexc.cmo : stdlib__printf.cmi stdlib__obj.cmi stdlib__buffer.cmi stdlib__array.cmi stdlib__printexc.cmi -stdlib__printexc.p.cmx : stdlib__printf.cmx stdlib__obj.cmx stdlib__buffer.cmx stdlib__array.cmx stdlib__printexc.cmi +stdlib__pervasives.cmo : camlinternalFormatBasics.cmi +stdlib__pervasives.p.cmx : camlinternalFormatBasics.cmx +stdlib__printexc.cmo : stdlib.cmi stdlib__printf.cmi stdlib__obj.cmi stdlib__buffer.cmi stdlib__array.cmi \ + stdlib__printexc.cmi +stdlib__printexc.p.cmx : stdlib.cmx stdlib__printf.cmx stdlib__obj.cmx stdlib__buffer.cmx stdlib__array.cmx \ + stdlib__printexc.cmi stdlib__printf.cmo : camlinternalFormatBasics.cmi camlinternalFormat.cmi stdlib__buffer.cmi \ stdlib__printf.cmi stdlib__printf.p.cmx : camlinternalFormatBasics.cmx camlinternalFormat.cmx stdlib__buffer.cmx \ stdlib__printf.cmi stdlib__queue.cmo : stdlib__seq.cmi stdlib__queue.cmi stdlib__queue.p.cmx : stdlib__seq.cmx stdlib__queue.cmi -stdlib__random.cmo : stdlib__string.cmi stdlib__nativeint.cmi stdlib__int64.cmi stdlib__int32.cmi stdlib__digest.cmi \ - stdlib__char.cmi stdlib__array.cmi stdlib__random.cmi -stdlib__random.p.cmx : stdlib__string.cmx stdlib__nativeint.cmx stdlib__int64.cmx stdlib__int32.cmx stdlib__digest.cmx \ - stdlib__char.cmx stdlib__array.cmx stdlib__random.cmi +stdlib__random.cmo : stdlib__string.cmi stdlib.cmi stdlib__nativeint.cmi stdlib__int64.cmi stdlib__int32.cmi \ + stdlib__digest.cmi stdlib__char.cmi stdlib__array.cmi stdlib__random.cmi +stdlib__random.p.cmx : stdlib__string.cmx stdlib.cmx stdlib__nativeint.cmx stdlib__int64.cmx stdlib__int32.cmx \ + stdlib__digest.cmx stdlib__char.cmx stdlib__array.cmx stdlib__random.cmi stdlib__result.cmo : stdlib__seq.cmi stdlib__result.cmi stdlib__result.p.cmx : stdlib__seq.cmx stdlib__result.cmi -stdlib__scanf.cmo : stdlib__string.cmi stdlib__printf.cmi stdlib__list.cmi camlinternalFormatBasics.cmi \ - camlinternalFormat.cmi stdlib__bytes.cmi stdlib__buffer.cmi stdlib__scanf.cmi -stdlib__scanf.p.cmx : stdlib__string.cmx stdlib__printf.cmx stdlib__list.cmx camlinternalFormatBasics.cmx \ - camlinternalFormat.cmx stdlib__bytes.cmx stdlib__buffer.cmx stdlib__scanf.cmi +stdlib__scanf.cmo : stdlib__string.cmi stdlib.cmi stdlib__printf.cmi stdlib__list.cmi \ + camlinternalFormatBasics.cmi camlinternalFormat.cmi stdlib__bytes.cmi stdlib__buffer.cmi \ + stdlib__scanf.cmi +stdlib__scanf.p.cmx : stdlib__string.cmx stdlib.cmx stdlib__printf.cmx stdlib__list.cmx \ + camlinternalFormatBasics.cmx camlinternalFormat.cmx stdlib__bytes.cmx stdlib__buffer.cmx \ + stdlib__scanf.cmi stdlib__seq.cmo : stdlib__seq.cmi stdlib__seq.p.cmx : stdlib__seq.cmi stdlib__set.cmo : stdlib__seq.cmi stdlib__list.cmi stdlib__set.cmi @@ -322,14 +334,14 @@ std_exit.cmo : std_exit.cmx : stdlib__stream.cmo : stdlib__string.cmi stdlib__list.cmi stdlib__lazy.cmi stdlib__bytes.cmi stdlib__stream.cmi stdlib__stream.p.cmx : stdlib__string.cmx stdlib__list.cmx stdlib__lazy.cmx stdlib__bytes.cmx stdlib__stream.cmi -stdlib__string.cmo : stdlib__bytes.cmi stdlib__string.cmi -stdlib__string.p.cmx : stdlib__bytes.cmx stdlib__string.cmi +stdlib__string.cmo : stdlib.cmi stdlib__bytes.cmi stdlib__string.cmi +stdlib__string.p.cmx : stdlib.cmx stdlib__bytes.cmx stdlib__string.cmi stdlib__stringLabels.cmo : stdlib__string.cmi stdlib__stringLabels.cmi stdlib__stringLabels.p.cmx : stdlib__string.cmx stdlib__stringLabels.cmi stdlib__sys.cmo : stdlib__sys.cmi stdlib__sys.p.cmx : stdlib__sys.cmi -stdlib__uchar.cmo : stdlib__char.cmi stdlib__uchar.cmi -stdlib__uchar.p.cmx : stdlib__char.cmx stdlib__uchar.cmi +stdlib__uchar.cmo : stdlib.cmi stdlib__char.cmi stdlib__uchar.cmi +stdlib__uchar.p.cmx : stdlib.cmx stdlib__char.cmx stdlib__uchar.cmi stdlib__weak.cmo : stdlib__sys.cmi stdlib__obj.cmi stdlib__hashtbl.cmi stdlib__array.cmi stdlib__weak.cmi stdlib__weak.p.cmx : stdlib__sys.cmx stdlib__obj.cmx stdlib__hashtbl.cmx stdlib__array.cmx stdlib__weak.cmi stdlib.cmo : camlinternalFormatBasics.cmi stdlib.cmi diff --git a/stdlib/Compflags b/stdlib/Compflags index 3796caa63..d22afa400 100755 --- a/stdlib/Compflags +++ b/stdlib/Compflags @@ -18,7 +18,6 @@ case $1 in stdlib.cm[iox]|stdlib.p.cmx) echo ' -nopervasives -no-alias-deps -w -49' \ ' -pp "$AWK -f expand_module_aliases.awk"';; - stdlib__pervasives.cm[iox]|stdlib__pervasives.p.cmx) echo ' -nopervasives';; camlinternalOO.cmx|camlinternalOO.p.cmx) echo ' -inline 0 -afl-inst-ratio 0';; camlinternalLazy.cmx|camlinternalLazy.p.cmx) echo ' -afl-inst-ratio 0';; # never instrument camlinternalOO or camlinternalLazy (PR#7725) @@ -31,7 +30,5 @@ case $1 in echo ' -w Ae';; stdlib__scanf.cmx|stdlib__scanf.p.cmx) echo ' -inline 9';; *Labels.cm[ox]|*Labels.p.cmx) echo ' -nolabels -no-alias-deps';; - pervasives.cm[iox]|pervasives.p.cmx) - echo ' -nopervasives -no-alias-deps -w -49';; *) echo ' ';; esac diff --git a/stdlib/Makefile b/stdlib/Makefile index 7c6305287..cf015e051 100644 --- a/stdlib/Makefile +++ b/stdlib/Makefile @@ -38,7 +38,7 @@ CAMLDEP=$(CAMLRUN) ../tools/ocamldep P=stdlib__ OBJS=camlinternalFormatBasics.cmo stdlib.cmo $(OTHERS) -OTHERS= $(P)seq.cmo $(P)option.cmo $(P)result.cmo \ +OTHERS= $(P)pervasives.cmo $(P)seq.cmo $(P)option.cmo $(P)result.cmo \ $(P)char.cmo $(P)uchar.cmo $(P)sys.cmo $(P)list.cmo \ $(P)bytes.cmo $(P)string.cmo \ $(P)marshal.cmo $(P)obj.cmo $(P)float.cmo $(P)array.cmo \ diff --git a/stdlib/StdlibModules b/stdlib/StdlibModules index ab8df2951..155593a1d 100644 --- a/stdlib/StdlibModules +++ b/stdlib/StdlibModules @@ -59,6 +59,7 @@ STDLIB_MODULES=\ $(P)oo \ $(P)option \ $(P)parsing \ + $(P)pervasives \ $(P)printexc \ $(P)printf \ $(P)queue \ diff --git a/stdlib/array.mli b/stdlib/array.mli index 0a9e7f3f6..876a123dc 100644 --- a/stdlib/array.mli +++ b/stdlib/array.mli @@ -219,7 +219,7 @@ val sort : ('a -> 'a -> int) -> 'a array -> unit function. The comparison function must return 0 if its arguments compare as equal, a positive integer if the first is greater, and a negative integer if the first is smaller (see below for a - complete specification). For example, {!Pervasives.compare} is + complete specification). For example, {!Stdlib.compare} is a suitable comparison function, provided there are no floating-point NaN values in the data. After calling [Array.sort], the array is sorted in place in increasing order. diff --git a/stdlib/arrayLabels.mli b/stdlib/arrayLabels.mli index 2ecf4dd29..dd525244a 100644 --- a/stdlib/arrayLabels.mli +++ b/stdlib/arrayLabels.mli @@ -219,7 +219,7 @@ val sort : cmp:('a -> 'a -> int) -> 'a array -> unit function. The comparison function must return 0 if its arguments compare as equal, a positive integer if the first is greater, and a negative integer if the first is smaller (see below for a - complete specification). For example, {!Pervasives.compare} is + complete specification). For example, {!Stdlib.compare} is a suitable comparison function, provided there are no floating-point NaN values in the data. After calling [Array.sort], the array is sorted in place in increasing order. diff --git a/stdlib/bigarray.mli b/stdlib/bigarray.mli index 39433dde8..50617c891 100644 --- a/stdlib/bigarray.mli +++ b/stdlib/bigarray.mli @@ -54,11 +54,11 @@ notation, e.g. [Array1.t] or [Array2.sub]. Big arrays support all the OCaml ad-hoc polymorphic operations: - - comparisons ([=], [<>], [<=], etc, as well as {!Pervasives.compare}); + - comparisons ([=], [<>], [<=], etc, as well as {!Stdlib.compare}); - hashing (module [Hash]); - and structured input-output (the functions from the - {!Marshal} module, as well as {!Pervasives.output_value} - and {!Pervasives.input_value}). + {!Marshal} module, as well as {!Stdlib.output_value} + and {!Stdlib.input_value}). *) (** {1 Element kinds} *) diff --git a/stdlib/bytes.ml b/stdlib/bytes.ml index 597c9afc2..afc7e15a3 100644 --- a/stdlib/bytes.ml +++ b/stdlib/bytes.ml @@ -319,7 +319,7 @@ let rcontains_from s i c = type t = bytes -let compare (x: t) (y: t) = Pervasives.compare x y +let compare (x: t) (y: t) = Stdlib.compare x y external equal : t -> t -> bool = "caml_bytes_equal" (* Deprecated functions implemented via other deprecated functions *) diff --git a/stdlib/bytes.mli b/stdlib/bytes.mli index 9854c4415..d2c655550 100644 --- a/stdlib/bytes.mli +++ b/stdlib/bytes.mli @@ -311,7 +311,7 @@ type t = bytes val compare: t -> t -> int (** The comparison function for byte sequences, with the same - specification as {!Pervasives.compare}. Along with the type [t], + specification as {!Stdlib.compare}. Along with the type [t], this function [compare] allows the module [Bytes] to be passed as argument to the functors {!Set.Make} and {!Map.Make}. *) diff --git a/stdlib/bytesLabels.mli b/stdlib/bytesLabels.mli index de690d2cf..7de0c72fb 100644 --- a/stdlib/bytesLabels.mli +++ b/stdlib/bytesLabels.mli @@ -285,7 +285,7 @@ type t = bytes val compare: t -> t -> int (** The comparison function for byte sequences, with the same - specification as {!Pervasives.compare}. Along with the type [t], + specification as {!Stdlib.compare}. Along with the type [t], this function [compare] allows the module [Bytes] to be passed as argument to the functors {!Set.Make} and {!Map.Make}. *) diff --git a/stdlib/char.mli b/stdlib/char.mli index 5d5fc0330..aaa627e4e 100644 --- a/stdlib/char.mli +++ b/stdlib/char.mli @@ -57,7 +57,7 @@ type t = char val compare: t -> t -> int (** The comparison function for characters, with the same specification as - {!Pervasives.compare}. Along with the type [t], this function [compare] + {!Stdlib.compare}. Along with the type [t], this function [compare] allows the module [Char] to be passed as argument to the functors {!Set.Make} and {!Map.Make}. *) diff --git a/stdlib/digest.mli b/stdlib/digest.mli index 2c9bebc52..9f9fd5342 100644 --- a/stdlib/digest.mli +++ b/stdlib/digest.mli @@ -29,7 +29,7 @@ type t = string val compare : t -> t -> int (** The comparison function for 16-character digest, with the same - specification as {!Pervasives.compare} and the implementation + specification as {!Stdlib.compare} and the implementation shared with {!String.compare}. Along with the type [t], this function [compare] allows the module [Digest] to be passed as argument to the functors {!Set.Make} and {!Map.Make}. diff --git a/stdlib/ephemeron.mli b/stdlib/ephemeron.mli index efa5f661a..66a3e9aca 100644 --- a/stdlib/ephemeron.mli +++ b/stdlib/ephemeron.mli @@ -56,7 +56,7 @@ Notes: - All the types defined in this module cannot be marshaled - using {!Pervasives.output_value} or the functions of the + using {!Stdlib.output_value} or the functions of the {!Marshal} module. Ephemerons are defined in a language agnostic way in this paper: diff --git a/stdlib/expand_module_aliases.awk b/stdlib/expand_module_aliases.awk index c373b3518..b9e99a81e 100644 --- a/stdlib/expand_module_aliases.awk +++ b/stdlib/expand_module_aliases.awk @@ -24,4 +24,6 @@ NR == 1 { printf ("# 1 \"%s\"\n", FILENAME) } else if ($1 == "module") printf ("\n(** @canonical %s *)\nmodule %s = Stdlib__%s%s\n", $2, $2, tolower(substr($4,1,1)), substr($4,2)); + else + print } diff --git a/stdlib/float.ml b/stdlib/float.ml index a5f903a00..8d9c5cca6 100644 --- a/stdlib/float.ml +++ b/stdlib/float.ml @@ -22,19 +22,19 @@ external div : float -> float -> float = "%divfloat" external rem : float -> float -> float = "caml_fmod_float" "fmod" [@@unboxed] [@@noalloc] external abs : float -> float = "%absfloat" -let infinity = Pervasives.infinity -let neg_infinity = Pervasives.neg_infinity -let nan = Pervasives.nan +let infinity = Stdlib.infinity +let neg_infinity = Stdlib.neg_infinity +let nan = Stdlib.nan let pi = 0x1.921fb54442d18p+1 -let max_float = Pervasives.max_float -let min_float = Pervasives.min_float -let epsilon = Pervasives.epsilon_float +let max_float = Stdlib.max_float +let min_float = Stdlib.min_float +let epsilon = Stdlib.epsilon_float external of_int : int -> float = "%floatofint" external to_int : float -> int = "%intoffloat" external of_string : string -> float = "caml_float_of_string" -let of_string_opt = Pervasives.float_of_string_opt -let to_string = Pervasives.string_of_float -type fpclass = Pervasives.fpclass = +let of_string_opt = Stdlib.float_of_string_opt +let to_string = Stdlib.string_of_float +type fpclass = Stdlib.fpclass = FP_normal | FP_subnormal | FP_zero diff --git a/stdlib/float.mli b/stdlib/float.mli index f7b4cd8d6..2cdd31608 100644 --- a/stdlib/float.mli +++ b/stdlib/float.mli @@ -112,7 +112,7 @@ val of_string_opt: string -> float option val to_string : float -> string (** Return the string representation of a floating-point number. *) -type fpclass = Pervasives.fpclass = +type fpclass = Stdlib.fpclass = FP_normal (** Normal number, none of the below *) | FP_subnormal (** Number very close to 0.0, has reduced precision *) | FP_zero (** Number is 0.0 or -0.0 *) diff --git a/stdlib/format.ml b/stdlib/format.ml index ff167195a..8bda14acb 100644 --- a/stdlib/format.ml +++ b/stdlib/format.ml @@ -937,9 +937,9 @@ let pp_make_buffer () = Buffer.create pp_buffer_size let stdbuf = pp_make_buffer () (* Predefined formatters standard formatter to print - to [Pervasives.stdout], [Pervasives.stderr], and {!stdbuf}. *) -let std_formatter = formatter_of_out_channel Pervasives.stdout -and err_formatter = formatter_of_out_channel Pervasives.stderr + to [Stdlib.stdout], [Stdlib.stderr], and {!stdbuf}. *) +let std_formatter = formatter_of_out_channel Stdlib.stdout +and err_formatter = formatter_of_out_channel Stdlib.stderr and str_formatter = formatter_of_buffer stdbuf @@ -1020,7 +1020,7 @@ let formatter_of_symbolic_output_buffer sob = (* Basic functions on the 'standard' formatter - (the formatter that prints to [Pervasives.stdout]). + (the formatter that prints to [Stdlib.stdout]). *) diff --git a/stdlib/format.mli b/stdlib/format.mli index 0fd986119..30c080b5c 100644 --- a/stdlib/format.mli +++ b/stdlib/format.mli @@ -27,8 +27,8 @@ abstract {{!section:formatter}formatters} which provide basic output functions. Some formatters are predefined, notably: - - {!std_formatter} outputs to {{!Pervasives.stdout}stdout} - - {!err_formatter} outputs to {{!Pervasives.stderr}stderr} + - {!std_formatter} outputs to {{!Stdlib.stdout}stdout} + - {!err_formatter} outputs to {{!Stdlib.stderr}stderr} Most functions in the {!Format} module come in two variants: a short version that operates on {!std_formatter} and the @@ -89,7 +89,7 @@ pending text, and resets the standard pretty-printer. Warning: mixing calls to pretty-printing functions of this module with - calls to {!Pervasives} low level output functions is error prone. + calls to {!Stdlib} low level output functions is error prone. The pretty-printing functions output material that is delayed in the pretty-printer queue and stacks in order to compute proper line @@ -98,9 +98,9 @@ may appear before the output of a pretty-printing function that has been called before. For instance, [ - Pervasives.print_string "<"; + Stdlib.print_string "<"; Format.print_string "PRETTY"; - Pervasives.print_string ">"; + Stdlib.print_string ">"; Format.print_string "TEXT"; ] leads to output [<>PRETTYTEXT]. @@ -329,7 +329,7 @@ val print_flush : unit -> unit disturb further pretty-printing. Warning: If the output device of the pretty-printer is an output channel, - repeated calls to [print_flush] means repeated calls to {!Pervasives.flush} + repeated calls to [print_flush] means repeated calls to {!Stdlib.flush} to flush the out channel; these explicit flush calls could foil the buffering strategy of output channels and could dramatically impact efficiency. @@ -616,8 +616,8 @@ val get_mark_tags : unit -> bool (** {1 Redirecting the standard formatter output} *) val pp_set_formatter_out_channel : - formatter -> Pervasives.out_channel -> unit -val set_formatter_out_channel : Pervasives.out_channel -> unit + formatter -> Stdlib.out_channel -> unit +val set_formatter_out_channel : Stdlib.out_channel -> unit (** Redirect the standard pretty-printer output to the given channel. (All the output functions of the standard formatter are set to the default output functions printing to the given channel.) @@ -683,9 +683,9 @@ type formatter_out_functions = { By default: - fields [out_string] and [out_flush] are output device specific; - (e.g. {!Pervasives.output_string} and {!Pervasives.flush} for a - {!Pervasives.out_channel} device, or [Buffer.add_substring] and - {!Pervasives.ignore} for a [Buffer.t] output device), + (e.g. {!Stdlib.output_string} and {!Stdlib.flush} for a + {!Stdlib.out_channel} device, or [Buffer.add_substring] and + {!Stdlib.ignore} for a [Buffer.t] output device), - field [out_newline] is equivalent to [out_string "\n" 0 1]; - fields [out_spaces] and [out_indent] are equivalent to [out_string (String.make n ' ') 0 n]. @@ -772,7 +772,7 @@ val get_formatter_tag_functions : unit -> formatter_tag_functions For instance, given a {!Buffer.t} buffer [b], {!formatter_of_buffer} [b] returns a new formatter using buffer [b] as its output device. - Similarly, given a {!Pervasives.out_channel} output channel [oc], + Similarly, given a {!Stdlib.out_channel} output channel [oc], {!formatter_of_out_channel} [oc] returns a new formatter using channel [oc] as its output device. @@ -789,13 +789,13 @@ val formatter_of_out_channel : out_channel -> formatter val std_formatter : formatter (** The standard formatter to write to standard output. - It is defined as {!formatter_of_out_channel} {!Pervasives.stdout}. + It is defined as {!formatter_of_out_channel} {!Stdlib.stdout}. *) val err_formatter : formatter (** A formatter to write to standard error. - It is defined as {!formatter_of_out_channel} {!Pervasives.stderr}. + It is defined as {!formatter_of_out_channel} {!Stdlib.stderr}. *) val formatter_of_buffer : Buffer.t -> formatter @@ -826,9 +826,9 @@ val make_formatter : For instance, {[ make_formatter - (Pervasives.output oc) - (fun () -> Pervasives.flush oc) ]} - returns a formatter to the {!Pervasives.out_channel} [oc]. + (Stdlib.output oc) + (fun () -> Stdlib.flush oc) ]} + returns a formatter to the {!Stdlib.out_channel} [oc]. *) val formatter_of_out_functions : diff --git a/stdlib/gc.mli b/stdlib/gc.mli index bae8c8bc9..cf3df7965 100644 --- a/stdlib/gc.mli +++ b/stdlib/gc.mli @@ -306,7 +306,7 @@ val finalise : ('a -> unit) -> 'a -> unit The results of calling {!String.make}, {!Bytes.make}, {!Bytes.create}, - {!Array.make}, and {!Pervasives.ref} are guaranteed to be + {!Array.make}, and {!Stdlib.ref} are guaranteed to be heap-allocated and non-constant except when the length argument is [0]. *) diff --git a/stdlib/hashtbl.mli b/stdlib/hashtbl.mli index a96c99c3d..2d9cd6c1b 100644 --- a/stdlib/hashtbl.mli +++ b/stdlib/hashtbl.mli @@ -298,7 +298,7 @@ module type HashedType = (provided objects do not contain floats) - ([(fun x y -> compare x y = 0)], {!Hashtbl.hash}) for comparing objects by structure - and handling {!Pervasives.nan} correctly + and handling {!Stdlib.nan} correctly - ([(==)], {!Hashtbl.hash}) for comparing objects by physical equality (e.g. for mutable or cyclic objects). *) end @@ -446,7 +446,7 @@ module MakeSeeded (H : SeededHashedType) : SeededS with type key = H.t val hash : 'a -> int (** [Hashtbl.hash x] associates a nonnegative integer to any value of any type. It is guaranteed that - if [x = y] or [Pervasives.compare x y = 0], then [hash x = hash y]. + if [x = y] or [Stdlib.compare x y = 0], then [hash x = hash y]. Moreover, [hash] always terminates, even on cyclic structures. *) val seeded_hash : int -> 'a -> int diff --git a/stdlib/int32.ml b/stdlib/int32.ml index 959c04248..9e1eabf5e 100644 --- a/stdlib/int32.ml +++ b/stdlib/int32.ml @@ -64,5 +64,5 @@ let of_string_opt s = type t = int32 -let compare (x: t) (y: t) = Pervasives.compare x y +let compare (x: t) (y: t) = Stdlib.compare x y let equal (x: t) (y: t) = compare x y = 0 diff --git a/stdlib/int32.mli b/stdlib/int32.mli index f7afec495..c9f91846c 100644 --- a/stdlib/int32.mli +++ b/stdlib/int32.mli @@ -50,7 +50,7 @@ external mul : int32 -> int32 -> int32 = "%int32_mul" external div : int32 -> int32 -> int32 = "%int32_div" (** Integer division. Raise [Division_by_zero] if the second argument is zero. This division rounds the real quotient of - its arguments towards zero, as specified for {!Pervasives.(/)}. *) + its arguments towards zero, as specified for {!Stdlib.(/)}. *) external rem : int32 -> int32 -> int32 = "%int32_mod" (** Integer remainder. If [y] is not zero, the result @@ -172,7 +172,7 @@ type t = int32 val compare: t -> t -> int (** The comparison function for 32-bit integers, with the same specification as - {!Pervasives.compare}. Along with the type [t], this function [compare] + {!Stdlib.compare}. Along with the type [t], this function [compare] allows the module [Int32] to be passed as argument to the functors {!Set.Make} and {!Map.Make}. *) diff --git a/stdlib/int64.ml b/stdlib/int64.ml index 8bc95a030..59e616481 100644 --- a/stdlib/int64.ml +++ b/stdlib/int64.ml @@ -71,5 +71,5 @@ external float_of_bits : int64 -> float type t = int64 -let compare (x: t) (y: t) = Pervasives.compare x y +let compare (x: t) (y: t) = Stdlib.compare x y let equal (x: t) (y: t) = compare x y = 0 diff --git a/stdlib/int64.mli b/stdlib/int64.mli index fed4b6484..b39ed9d25 100644 --- a/stdlib/int64.mli +++ b/stdlib/int64.mli @@ -51,7 +51,7 @@ external mul : int64 -> int64 -> int64 = "%int64_mul" external div : int64 -> int64 -> int64 = "%int64_div" (** Integer division. Raise [Division_by_zero] if the second argument is zero. This division rounds the real quotient of - its arguments towards zero, as specified for {!Pervasives.(/)}. *) + its arguments towards zero, as specified for {!Stdlib.(/)}. *) external rem : int64 -> int64 -> int64 = "%int64_mod" (** Integer remainder. If [y] is not zero, the result @@ -193,7 +193,7 @@ type t = int64 val compare: t -> t -> int (** The comparison function for 64-bit integers, with the same specification as - {!Pervasives.compare}. Along with the type [t], this function [compare] + {!Stdlib.compare}. Along with the type [t], this function [compare] allows the module [Int64] to be passed as argument to the functors {!Set.Make} and {!Map.Make}. *) diff --git a/stdlib/list.mli b/stdlib/list.mli index e7a339b5d..c9129f430 100644 --- a/stdlib/list.mli +++ b/stdlib/list.mli @@ -309,7 +309,7 @@ val sort : ('a -> 'a -> int) -> 'a list -> 'a list compare as equal, a positive integer if the first is greater, and a negative integer if the first is smaller (see Array.sort for a complete specification). For example, - {!Pervasives.compare} is a suitable comparison function. + {!Stdlib.compare} is a suitable comparison function. The resulting list is sorted in increasing order. [List.sort] is guaranteed to run in constant heap space (in addition to the size of the result list) and logarithmic diff --git a/stdlib/listLabels.mli b/stdlib/listLabels.mli index ab6980c21..022c7c166 100644 --- a/stdlib/listLabels.mli +++ b/stdlib/listLabels.mli @@ -315,7 +315,7 @@ val sort : cmp:('a -> 'a -> int) -> 'a list -> 'a list compare as equal, a positive integer if the first is greater, and a negative integer if the first is smaller (see Array.sort for a complete specification). For example, - {!Pervasives.compare} is a suitable comparison function. + {!Stdlib.compare} is a suitable comparison function. The resulting list is sorted in increasing order. [List.sort] is guaranteed to run in constant heap space (in addition to the size of the result list) and logarithmic diff --git a/stdlib/map.mli b/stdlib/map.mli index 531fb8fe6..5980bad0f 100644 --- a/stdlib/map.mli +++ b/stdlib/map.mli @@ -28,8 +28,8 @@ struct type t = int * int let compare (x0,y0) (x1,y1) = - match Pervasives.compare x0 x1 with - 0 -> Pervasives.compare y0 y1 + match Stdlib.compare x0 x1 with + 0 -> Stdlib.compare y0 y1 | c -> c end @@ -55,7 +55,7 @@ module type OrderedType = [f e1 e2] is strictly negative if [e1] is smaller than [e2], and [f e1 e2] is strictly positive if [e1] is greater than [e2]. Example: a suitable ordering function is the generic structural - comparison function {!Pervasives.compare}. *) + comparison function {!Stdlib.compare}. *) end (** Input signature of the functor {!Map.Make}. *) diff --git a/stdlib/nativeint.ml b/stdlib/nativeint.ml index 2f6fe7802..2a7bf4366 100644 --- a/stdlib/nativeint.ml +++ b/stdlib/nativeint.ml @@ -61,5 +61,5 @@ let of_string_opt s = type t = nativeint -let compare (x: t) (y: t) = Pervasives.compare x y +let compare (x: t) (y: t) = Stdlib.compare x y let equal (x: t) (y: t) = compare x y = 0 diff --git a/stdlib/nativeint.mli b/stdlib/nativeint.mli index 70ac696ad..327e44efb 100644 --- a/stdlib/nativeint.mli +++ b/stdlib/nativeint.mli @@ -54,7 +54,7 @@ external mul : nativeint -> nativeint -> nativeint = "%nativeint_mul" external div : nativeint -> nativeint -> nativeint = "%nativeint_div" (** Integer division. Raise [Division_by_zero] if the second argument is zero. This division rounds the real quotient of - its arguments towards zero, as specified for {!Pervasives.(/)}. *) + its arguments towards zero, as specified for {!Stdlib.(/)}. *) external rem : nativeint -> nativeint -> nativeint = "%nativeint_mod" (** Integer remainder. If [y] is not zero, the result @@ -183,7 +183,7 @@ type t = nativeint val compare: t -> t -> int (** The comparison function for native integers, with the same specification as - {!Pervasives.compare}. Along with the type [t], this function [compare] + {!Stdlib.compare}. Along with the type [t], this function [compare] allows the module [Nativeint] to be passed as argument to the functors {!Set.Make} and {!Map.Make}. *) diff --git a/stdlib/pervasives.ml b/stdlib/pervasives.ml new file mode 100644 index 000000000..945512716 --- /dev/null +++ b/stdlib/pervasives.ml @@ -0,0 +1,242 @@ +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Jeremie Dimino, Jane Street Europe *) +(* *) +(* Copyright 2017 Jane Street Group LLC *) +(* *) +(* 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. *) +(* *) +(**************************************************************************) + +external raise : exn -> 'a = "%raise" +external raise_notrace : exn -> 'a = "%raise_notrace" +let invalid_arg = invalid_arg +let failwith = failwith +exception Exit +external ( = ) : 'a -> 'a -> bool = "%equal" +external ( <> ) : 'a -> 'a -> bool = "%notequal" +external ( < ) : 'a -> 'a -> bool = "%lessthan" +external ( > ) : 'a -> 'a -> bool = "%greaterthan" +external ( <= ) : 'a -> 'a -> bool = "%lessequal" +external ( >= ) : 'a -> 'a -> bool = "%greaterequal" +external compare : 'a -> 'a -> int = "%compare" +let min = min +let max = max +external ( == ) : 'a -> 'a -> bool = "%eq" +external ( != ) : 'a -> 'a -> bool = "%noteq" +external not : bool -> bool = "%boolnot" +external ( && ) : bool -> bool -> bool = "%sequand" +external ( & ) : bool -> bool -> bool = "%sequand" + [@@ocaml.deprecated "Use (&&) instead."] +external ( || ) : bool -> bool -> bool = "%sequor" +external ( or ) : bool -> bool -> bool = "%sequor" + [@@ocaml.deprecated "Use (||) instead."] +external __LOC__ : string = "%loc_LOC" +external __FILE__ : string = "%loc_FILE" +external __LINE__ : int = "%loc_LINE" +external __MODULE__ : string = "%loc_MODULE" +external __POS__ : string * int * int * int = "%loc_POS" +external __LOC_OF__ : 'a -> string * 'a = "%loc_LOC" +external __LINE_OF__ : 'a -> int * 'a = "%loc_LINE" +external __POS_OF__ : 'a -> (string * int * int * int) * 'a = "%loc_POS" +external ( |> ) : 'a -> ('a -> 'b) -> 'b = "%revapply" +external ( @@ ) : ('a -> 'b) -> 'a -> 'b = "%apply" +external ( ~- ) : int -> int = "%negint" +external ( ~+ ) : int -> int = "%identity" +external succ : int -> int = "%succint" +external pred : int -> int = "%predint" +external ( + ) : int -> int -> int = "%addint" +external ( - ) : int -> int -> int = "%subint" +external ( * ) : int -> int -> int = "%mulint" +external ( / ) : int -> int -> int = "%divint" +external ( mod ) : int -> int -> int = "%modint" +let abs = abs +let max_int = max_int +let min_int = min_int +external ( land ) : int -> int -> int = "%andint" +external ( lor ) : int -> int -> int = "%orint" +external ( lxor ) : int -> int -> int = "%xorint" +let lnot = lnot +external ( lsl ) : int -> int -> int = "%lslint" +external ( lsr ) : int -> int -> int = "%lsrint" +external ( asr ) : int -> int -> int = "%asrint" +external ( ~-. ) : float -> float = "%negfloat" +external ( ~+. ) : float -> float = "%identity" +external ( +. ) : float -> float -> float = "%addfloat" +external ( -. ) : float -> float -> float = "%subfloat" +external ( *. ) : float -> float -> float = "%mulfloat" +external ( /. ) : float -> float -> float = "%divfloat" +external ( ** ) : float -> float -> float = "caml_power_float" "pow" + [@@unboxed] [@@noalloc] +external sqrt : float -> float = "caml_sqrt_float" "sqrt" + [@@unboxed] [@@noalloc] +external exp : float -> float = "caml_exp_float" "exp" [@@unboxed] [@@noalloc] +external log : float -> float = "caml_log_float" "log" [@@unboxed] [@@noalloc] +external log10 : float -> float = "caml_log10_float" "log10" + [@@unboxed] [@@noalloc] +external expm1 : float -> float = "caml_expm1_float" "caml_expm1" + [@@unboxed] [@@noalloc] +external log1p : float -> float = "caml_log1p_float" "caml_log1p" + [@@unboxed] [@@noalloc] +external cos : float -> float = "caml_cos_float" "cos" [@@unboxed] [@@noalloc] +external sin : float -> float = "caml_sin_float" "sin" [@@unboxed] [@@noalloc] +external tan : float -> float = "caml_tan_float" "tan" [@@unboxed] [@@noalloc] +external acos : float -> float = "caml_acos_float" "acos" + [@@unboxed] [@@noalloc] +external asin : float -> float = "caml_asin_float" "asin" + [@@unboxed] [@@noalloc] +external atan : float -> float = "caml_atan_float" "atan" + [@@unboxed] [@@noalloc] +external atan2 : float -> float -> float = "caml_atan2_float" "atan2" + [@@unboxed] [@@noalloc] +external hypot : float -> float -> float = "caml_hypot_float" "caml_hypot" + [@@unboxed] [@@noalloc] +external cosh : float -> float = "caml_cosh_float" "cosh" + [@@unboxed] [@@noalloc] +external sinh : float -> float = "caml_sinh_float" "sinh" + [@@unboxed] [@@noalloc] +external tanh : float -> float = "caml_tanh_float" "tanh" + [@@unboxed] [@@noalloc] +external ceil : float -> float = "caml_ceil_float" "ceil" + [@@unboxed] [@@noalloc] +external floor : float -> float = "caml_floor_float" "floor" + [@@unboxed] [@@noalloc] +external abs_float : float -> float = "%absfloat" +external copysign : float -> float -> float + = "caml_copysign_float" "caml_copysign" + [@@unboxed] [@@noalloc] +external mod_float : float -> float -> float = "caml_fmod_float" "fmod" + [@@unboxed] [@@noalloc] +external frexp : float -> float * int = "caml_frexp_float" +external ldexp : (float [@unboxed]) -> (int [@untagged]) -> (float [@unboxed]) = + "caml_ldexp_float" "caml_ldexp_float_unboxed" [@@noalloc] +external modf : float -> float * float = "caml_modf_float" +external float : int -> float = "%floatofint" +external float_of_int : int -> float = "%floatofint" +external truncate : float -> int = "%intoffloat" +external int_of_float : float -> int = "%intoffloat" +let infinity = infinity +let neg_infinity = neg_infinity +let nan = nan +let max_float = max_float +let min_float = min_float +let epsilon_float = epsilon_float +type nonrec fpclass = fpclass = + FP_normal + | FP_subnormal + | FP_zero + | FP_infinite + | FP_nan +external classify_float : (float [@unboxed]) -> fpclass = + "caml_classify_float" "caml_classify_float_unboxed" [@@noalloc] +let ( ^ ) = ( ^ ) +external int_of_char : char -> int = "%identity" +let char_of_int = char_of_int +external ignore : 'a -> unit = "%ignore" +let string_of_bool = string_of_bool +let bool_of_string = bool_of_string +let bool_of_string_opt = bool_of_string_opt +let string_of_int = string_of_int +external int_of_string : string -> int = "caml_int_of_string" +let int_of_string_opt = int_of_string_opt +let string_of_float = string_of_float +external float_of_string : string -> float = "caml_float_of_string" +let float_of_string_opt = float_of_string_opt +external fst : 'a * 'b -> 'a = "%field0" +external snd : 'a * 'b -> 'b = "%field1" +let ( @ ) = ( @ ) +type nonrec in_channel = in_channel +type nonrec out_channel = out_channel +let stdin = stdin +let stdout = stdout +let stderr = stderr +let print_char = print_char +let print_string = print_string +let print_bytes = print_bytes +let print_int = print_int +let print_float = print_float +let print_endline = print_endline +let print_newline = print_newline +let prerr_char = prerr_char +let prerr_string = prerr_string +let prerr_bytes = prerr_bytes +let prerr_int = prerr_int +let prerr_float = prerr_float +let prerr_endline = prerr_endline +let prerr_newline = prerr_newline +let read_line = read_line +let read_int = read_int +let read_int_opt = read_int_opt +let read_float = read_float +let read_float_opt = read_float_opt +type nonrec open_flag = open_flag = + Open_rdonly + | Open_wronly + | Open_append + | Open_creat + | Open_trunc + | Open_excl + | Open_binary + | Open_text + | Open_nonblock +let open_out = open_out +let open_out_bin = open_out_bin +let open_out_gen = open_out_gen +let flush = flush +let flush_all = flush_all +let output_char = output_char +let output_string = output_string +let output_bytes = output_bytes +let output = output +let output_substring = output_substring +let output_byte = output_byte +let output_binary_int = output_binary_int +let output_value = output_value +let seek_out = seek_out +let pos_out = pos_out +let out_channel_length = out_channel_length +let close_out = close_out +let close_out_noerr = close_out_noerr +let set_binary_mode_out = set_binary_mode_out +let open_in = open_in +let open_in_bin = open_in_bin +let open_in_gen = open_in_gen +let input_char = input_char +let input_line = input_line +let input = input +let really_input = really_input +let really_input_string = really_input_string +let input_byte = input_byte +let input_binary_int = input_binary_int +let input_value = input_value +let seek_in = seek_in +let pos_in = pos_in +let in_channel_length = in_channel_length +let close_in = close_in +let close_in_noerr = close_in_noerr +let set_binary_mode_in = set_binary_mode_in +module LargeFile = LargeFile +type nonrec 'a ref = 'a ref = { mutable contents : 'a } +external ref : 'a -> 'a ref = "%makemutable" +external ( ! ) : 'a ref -> 'a = "%field0" +external ( := ) : 'a ref -> 'a -> unit = "%setfield0" +external incr : int ref -> unit = "%incr" +external decr : int ref -> unit = "%decr" +type ('a,'b) result = Ok of 'a | Error of 'b +type ('a, 'b, 'c, 'd, 'e, 'f) format6 = + ('a, 'b, 'c, 'd, 'e, 'f) CamlinternalFormatBasics.format6 +type ('a, 'b, 'c, 'd) format4 = ('a, 'b, 'c, 'c, 'c, 'd) format6 +type ('a, 'b, 'c) format = ('a, 'b, 'c, 'c) format4 +let string_of_format = string_of_format +external format_of_string : + ('a, 'b, 'c, 'd, 'e, 'f) format6 -> + ('a, 'b, 'c, 'd, 'e, 'f) format6 = "%identity" +let ( ^^ ) = ( ^^ ) +let exit = exit +let at_exit = at_exit +let valid_float_lexem = valid_float_lexem +let do_at_exit = do_at_exit diff --git a/stdlib/printexc.ml b/stdlib/printexc.ml index 9b18f4ca9..747c2f4cc 100644 --- a/stdlib/printexc.ml +++ b/stdlib/printexc.ml @@ -285,7 +285,7 @@ let handle_uncaught_exception' exn debugger_in_use = else try_get_raw_backtrace () in - (try Pervasives.do_at_exit () with _ -> ()); + (try Stdlib.do_at_exit () with _ -> ()); match !uncaught_exception_handler with | None -> eprintf "Fatal error: exception %s\n" (to_string exn); diff --git a/stdlib/printexc.mli b/stdlib/printexc.mli index 873e385f6..88e0a4525 100644 --- a/stdlib/printexc.mli +++ b/stdlib/printexc.mli @@ -159,7 +159,7 @@ val set_uncaught_exception_handler: (exn -> raw_backtrace -> unit) -> unit backtrace on standard error output. Note that when [fn] is called all the functions registered with - {!Pervasives.at_exit} have already been called. Because of this you must + {!Stdlib.at_exit} have already been called. Because of this you must make sure any output channel [fn] writes on is flushed. Also note that exceptions raised by user code in the interactive toplevel diff --git a/stdlib/random.ml b/stdlib/random.ml index 76e9fa175..1c33e5e6e 100644 --- a/stdlib/random.ml +++ b/stdlib/random.ml @@ -134,8 +134,8 @@ module State = struct (* Returns a float 0 <= x <= 1 with at most 60 bits of precision. *) let rawfloat s = let scale = 1073741824.0 (* 2^30 *) - and r1 = Pervasives.float (bits s) - and r2 = Pervasives.float (bits s) + and r1 = Stdlib.float (bits s) + and r2 = Stdlib.float (bits s) in (r1 /. scale +. r2) /. scale @@ -223,7 +223,7 @@ init 299792643; init_diff2 100; chisquare diff2 100000 100 (* Return the sum of the squares of v[i0,i1[ *) let rec sumsq v i0 i1 = if i0 >= i1 then 0.0 - else if i1 = i0 + 1 then Pervasives.float v.(i0) *. Pervasives.float v.(i0) + else if i1 = i0 + 1 then Stdlib.float v.(i0) *. Stdlib.float v.(i0) else sumsq v i0 ((i0+i1)/2) +. sumsq v ((i0+i1)/2) i1 @@ -235,8 +235,8 @@ let chisquare g n r = f.(t) <- f.(t) + 1 done; let t = sumsq f 0 r - and r = Pervasives.float r - and n = Pervasives.float n in + and r = Stdlib.float r + and n = Stdlib.float n in let sr = 2.0 *. sqrt r in (r -. sr, (r *. t /. n) -. n, r +. sr) diff --git a/stdlib/scanf.ml b/stdlib/scanf.ml index 8daf2cc67..b4d62a812 100644 --- a/stdlib/scanf.ml +++ b/stdlib/scanf.ml @@ -17,14 +17,14 @@ open CamlinternalFormatBasics open CamlinternalFormat (* alias to avoid warning for ambiguity between - Pervasives.format6 + Stdlib.format6 and CamlinternalFormatBasics.format6 (the former is in fact an alias for the latter, but the ambiguity warning doesn't care) *) type ('a, 'b, 'c, 'd, 'e, 'f) format6 = - ('a, 'b, 'c, 'd, 'e, 'f) Pervasives.format6 + ('a, 'b, 'c, 'd, 'e, 'f) Stdlib.format6 (* The run-time library for scanners. *) @@ -39,12 +39,12 @@ module type SCANNING = sig type file_name = string val stdin : in_channel - (* The scanning buffer reading from [Pervasives.stdin]. - [stdib] is equivalent to [Scanning.from_channel Pervasives.stdin]. *) + (* The scanning buffer reading from [Stdlib.stdin]. + [stdib] is equivalent to [Scanning.from_channel Stdlib.stdin]. *) val stdib : in_channel (* An alias for [Scanf.stdin], the scanning buffer reading from - [Pervasives.stdin]. *) + [Stdlib.stdin]. *) val next_char : scanbuf -> char (* [Scanning.next_char ib] advance the scanning buffer for @@ -126,11 +126,11 @@ module type SCANNING = sig val from_file_bin : file_name -> in_channel val from_string : string -> in_channel val from_function : (unit -> char) -> in_channel - val from_channel : Pervasives.in_channel -> in_channel + val from_channel : Stdlib.in_channel -> in_channel val close_in : in_channel -> unit - val memo_from_channel : Pervasives.in_channel -> in_channel + val memo_from_channel : Stdlib.in_channel -> in_channel (* Obsolete. *) end @@ -143,8 +143,8 @@ module Scanning : SCANNING = struct type file_name = string type in_channel_name = - | From_channel of Pervasives.in_channel - | From_file of file_name * Pervasives.in_channel + | From_channel of Stdlib.in_channel + | From_file of file_name * Stdlib.in_channel | From_function | From_string @@ -213,7 +213,7 @@ module Scanning : SCANNING = struct let name_of_input ib = match ib.ic_input_name with - | From_channel _ic -> "unnamed Pervasives input channel" + | From_channel _ic -> "unnamed Stdlib input channel" | From_file (fname, _ic) -> fname | From_function -> "unnamed function" | From_string -> "unnamed character string" @@ -325,7 +325,7 @@ module Scanning : SCANNING = struct let file_buffer_size = ref 1024 (* The scanner closes the input channel at end of input. *) - let scan_close_at_end ic = Pervasives.close_in ic; raise End_of_file + let scan_close_at_end ic = Stdlib.close_in ic; raise End_of_file (* The scanner does not close the input channel at end of input: it just raises [End_of_file]. *) @@ -352,13 +352,13 @@ module Scanning : SCANNING = struct let from_ic_close_at_end = from_ic scan_close_at_end let from_ic_raise_at_end = from_ic scan_raise_at_end - (* The scanning buffer reading from [Pervasives.stdin]. + (* The scanning buffer reading from [Stdlib.stdin]. One could try to define [stdib] as a scanning buffer reading a character at a time (no bufferization at all), but unfortunately the top-level interaction would be wrong. This is due to some kind of - 'race condition' when reading from [Pervasives.stdin], + 'race condition' when reading from [Stdlib.stdin], since the interactive compiler and [Scanf.scanf] will simultaneously - read the material they need from [Pervasives.stdin]; then, confusion + read the material they need from [Stdlib.stdin]; then, confusion will result from what should be read by the top-level and what should be read by [Scanf.scanf]. This is even more complicated by the one character lookahead that @@ -369,7 +369,7 @@ module Scanning : SCANNING = struct characters have been read, we simply ask to read more. *) let stdin = from_ic scan_raise_at_end - (From_file ("-", Pervasives.stdin)) Pervasives.stdin + (From_file ("-", Stdlib.stdin)) Stdlib.stdin let stdib = stdin @@ -382,8 +382,8 @@ module Scanning : SCANNING = struct from_ic_close_at_end (From_file (fname, ic)) ic - let open_in = open_in_file Pervasives.open_in - let open_in_bin = open_in_file Pervasives.open_in_bin + let open_in = open_in_file Stdlib.open_in + let open_in_bin = open_in_file Stdlib.open_in_bin let from_file = open_in let from_file_bin = open_in_bin @@ -395,14 +395,14 @@ module Scanning : SCANNING = struct let close_in ib = match ib.ic_input_name with | From_channel ic -> - Pervasives.close_in ic - | From_file (_fname, ic) -> Pervasives.close_in ic + Stdlib.close_in ic + | From_file (_fname, ic) -> Stdlib.close_in ic | From_function | From_string -> () (* Obsolete: a memo [from_channel] version to build a [Scanning.in_channel] - scanning buffer out of a [Pervasives.in_channel]. + scanning buffer out of a [Stdlib.in_channel]. This function was used to try to preserve the scanning semantics for the (now obsolete) function [fscanf]. Given that all scanner must read from a [Scanning.in_channel] scanning @@ -411,7 +411,7 @@ module Scanning : SCANNING = struct from the same scanning buffer. This obliged this library to allocated scanning buffers that were not properly garbage collectable, hence leading to memory leaks. - If you need to read from a [Pervasives.in_channel] input channel + If you need to read from a [Stdlib.in_channel] input channel [ic], simply define a [Scanning.in_channel] formatted input channel as in [let ib = Scanning.from_channel ic], then use [Scanf.bscanf ib] as usual. *) @@ -556,7 +556,7 @@ let integer_conversion_of_char = function (* Extract an integer literal token. - Since the functions Pervasives.*int*_of_string do not accept a leading +, + Since the functions Stdlib.*int*_of_string do not accept a leading +, we skip it if necessary. *) let token_int_literal conv ib = let tok = diff --git a/stdlib/scanf.mli b/stdlib/scanf.mli index c3d2a6a8a..2b360cb9d 100644 --- a/stdlib/scanf.mli +++ b/stdlib/scanf.mli @@ -88,7 +88,7 @@ module Scanning : sig type in_channel (** The notion of input channel for the {!Scanf} module: those channels provide all the machinery necessary to read from any source - of characters, including a {!Pervasives.in_channel} value. + of characters, including a {!Stdlib.in_channel} value. A Scanf.Scanning.in_channel value is also called a {i formatted input channel} or equivalently a {i scanning buffer}. The type {!Scanning.scanbuf} below is an alias for [Scanning.in_channel]. @@ -110,10 +110,10 @@ type scanbuf = in_channel val stdin : in_channel (** The standard input notion for the {!Scanf} module. [Scanning.stdin] is the {!Scanning.in_channel} formatted input channel - attached to {!Pervasives.stdin}. + attached to {!Stdlib.stdin}. Note: in the interactive system, when input is read from - {!Pervasives.stdin}, the newline character that triggers evaluation is + {!Stdlib.stdin}, the newline character that triggers evaluation is part of the input; thus, the scanning specifications must properly skip this additional newline character (for instance, simply add a ['\n'] as the last character of the format string). @@ -144,7 +144,7 @@ val open_in_bin : file_name -> in_channel *) val close_in : in_channel -> unit -(** Closes the {!Pervasives.in_channel} associated with the given +(** Closes the {!Stdlib.in_channel} associated with the given {!Scanning.in_channel} formatted input channel. @since 3.12.0 *) @@ -172,9 +172,9 @@ val from_function : (unit -> char) -> in_channel end-of-input condition by raising the exception [End_of_file]. *) -val from_channel : Pervasives.in_channel -> in_channel +val from_channel : Stdlib.in_channel -> in_channel (** [Scanning.from_channel ic] returns a {!Scanning.in_channel} formatted - input channel which reads from the regular {!Pervasives.in_channel} input + input channel which reads from the regular {!Stdlib.in_channel} input channel [ic] argument. Reading starts at current reading position of [ic]. *) @@ -198,7 +198,7 @@ val name_of_input : in_channel -> string val stdib : in_channel [@@ocaml.deprecated "Use Scanf.Scanning.stdin instead."] (** A deprecated alias for {!Scanning.stdin}, the scanning buffer reading from - {!Pervasives.stdin}. + {!Stdlib.stdin}. *) end @@ -218,7 +218,7 @@ type ('a, 'b, 'c, 'd) scanner = For instance, the {!Scanf.scanf} function below has type [('a, 'b, 'c, 'd) scanner], since it is a formatted input function that reads from {!Scanning.stdin}: [scanf fmt f] applies [f] to the arguments - specified by [fmt], reading those arguments from {!Pervasives.stdin} as + specified by [fmt], reading those arguments from {!Stdlib.stdin} as expected. If the format [fmt] has some [%r] indications, the corresponding @@ -471,7 +471,7 @@ val sscanf : string -> ('a, 'b, 'c, 'd) scanner val scanf : ('a, 'b, 'c, 'd) scanner (** Same as {!Scanf.bscanf}, but reads from the predefined formatted input - channel {!Scanf.Scanning.stdin} that is connected to {!Pervasives.stdin}. + channel {!Scanf.Scanning.stdin} that is connected to {!Stdlib.stdin}. *) val kscanf : @@ -537,7 +537,7 @@ val unescaped : string -> string (** {1 Deprecated} *) -val fscanf : Pervasives.in_channel -> ('a, 'b, 'c, 'd) scanner +val fscanf : Stdlib.in_channel -> ('a, 'b, 'c, 'd) scanner [@@ocaml.deprecated "Use Scanning.from_channel then Scanf.bscanf."] (** @deprecated [Scanf.fscanf] is error prone and deprecated since 4.03.0. @@ -546,14 +546,14 @@ val fscanf : Pervasives.in_channel -> ('a, 'b, 'c, 'd) scanner must read from a user defined {!Scanning.in_channel} formatted input channel. - If you need to read from a {!Pervasives.in_channel} input channel + If you need to read from a {!Stdlib.in_channel} input channel [ic], simply define a {!Scanning.in_channel} formatted input channel as in [let ib = Scanning.from_channel ic], then use [Scanf.bscanf ib] as usual. *) val kfscanf : - Pervasives.in_channel -> (Scanning.in_channel -> exn -> 'd) -> + Stdlib.in_channel -> (Scanning.in_channel -> exn -> 'd) -> ('a, 'b, 'c, 'd) scanner [@@ocaml.deprecated "Use Scanning.from_channel then Scanf.kscanf."] (** @deprecated [Scanf.kfscanf] is error prone and deprecated since 4.03.0. *) diff --git a/stdlib/set.mli b/stdlib/set.mli index 5b7f92ff5..4e8e94bf7 100644 --- a/stdlib/set.mli +++ b/stdlib/set.mli @@ -30,8 +30,8 @@ struct type t = int * int let compare (x0,y0) (x1,y1) = - match Pervasives.compare x0 x1 with - 0 -> Pervasives.compare y0 y1 + match Stdlib.compare x0 x1 with + 0 -> Stdlib.compare y0 y1 | c -> c end @@ -56,7 +56,7 @@ module type OrderedType = [f e1 e2] is strictly negative if [e1] is smaller than [e2], and [f e1 e2] is strictly positive if [e1] is greater than [e2]. Example: a suitable ordering function is the generic structural - comparison function {!Pervasives.compare}. *) + comparison function {!Stdlib.compare}. *) end (** Input signature of the functor {!Set.Make}. *) diff --git a/stdlib/stdlib.ml b/stdlib/stdlib.ml index 12ad4205f..425728f64 100644 --- a/stdlib/stdlib.ml +++ b/stdlib/stdlib.ml @@ -13,7 +13,6 @@ (* *) (**************************************************************************) -module Pervasives = struct (* type 'a option = None | Some of 'a *) (* Exceptions *) @@ -566,9 +565,6 @@ let exit retcode = sys_exit retcode let _ = register_named_value "Pervasives.do_at_exit" do_at_exit -end - -include Pervasives (*MODULE_ALIASES*) module Arg = Arg @@ -603,6 +599,7 @@ module Obj = Obj module Oo = Oo module Option = Option module Parsing = Parsing +module Pervasives = Pervasives module Printexc = Printexc module Printf = Printf module Queue = Queue diff --git a/stdlib/stdlib.mli b/stdlib/stdlib.mli index c68c4e214..d451bba9c 100644 --- a/stdlib/stdlib.mli +++ b/stdlib/stdlib.mli @@ -18,19 +18,12 @@ This module is automatically opened at the beginning of each compilation. All components of this module can therefore be referred by their short name, without prefixing them by [Stdlib]. -*) -module Pervasives : sig -(** Pervasive operations. - - This module provides the basic operations over the built-in types + It particular, it provides the basic operations over the built-in types (numbers, booleans, byte sequences, strings, exceptions, references, lists, arrays, input-output channels, ...). - - This module is included in the toplevel [Stdlib] module. *) - (** {1 Exceptions} *) external raise : exn -> 'a = "%raise" @@ -72,19 +65,19 @@ external ( = ) : 'a -> 'a -> bool = "%equal" Left-associative operator at precedence level 4/11. *) external ( <> ) : 'a -> 'a -> bool = "%notequal" -(** Negation of {!Pervasives.( = )}. +(** Negation of {!Stdlib.( = )}. Left-associative operator at precedence level 4/11. *) external ( < ) : 'a -> 'a -> bool = "%lessthan" -(** See {!Pervasives.( >= )}. +(** See {!Stdlib.( >= )}. Left-associative operator at precedence level 4/11. *) external ( > ) : 'a -> 'a -> bool = "%greaterthan" -(** See {!Pervasives.( >= )}. +(** See {!Stdlib.( >= )}. Left-associative operator at precedence level 4/11. *) external ( <= ) : 'a -> 'a -> bool = "%lessequal" -(** See {!Pervasives.( >= )}. +(** See {!Stdlib.( >= )}. Left-associative operator at precedence level 4/11. *) external ( >= ) : 'a -> 'a -> bool = "%greaterequal" @@ -104,7 +97,7 @@ external compare : 'a -> 'a -> int = "%compare" if [x] is greater than [y]. The ordering implemented by [compare] is compatible with the comparison predicates [=], [<] and [>] defined above, with one difference on the treatment of the float value - {!Pervasives.nan}. Namely, the comparison predicates treat [nan] + {!Stdlib.nan}. Namely, the comparison predicates treat [nan] as different from any other float value, including itself; while [compare] treats [nan] as equal to itself and less than any other float value. This treatment of [nan] ensures that [compare] @@ -139,7 +132,7 @@ external ( == ) : 'a -> 'a -> bool = "%eq" Left-associative operator at precedence level 4/11. *) external ( != ) : 'a -> 'a -> bool = "%noteq" -(** Negation of {!Pervasives.( == )}. +(** Negation of {!Stdlib.( == )}. Left-associative operator at precedence level 4/11. *) @@ -156,7 +149,7 @@ external ( && ) : bool -> bool -> bool = "%sequand" external ( & ) : bool -> bool -> bool = "%sequand" [@@ocaml.deprecated "Use (&&) instead."] -(** @deprecated {!Pervasives.( && )} should be used instead. +(** @deprecated {!Stdlib.( && )} should be used instead. Right-associative operator at precedence level 3/11. *) external ( || ) : bool -> bool -> bool = "%sequor" @@ -168,7 +161,7 @@ external ( || ) : bool -> bool -> bool = "%sequor" external ( or ) : bool -> bool -> bool = "%sequor" [@@ocaml.deprecated "Use (||) instead."] -(** @deprecated {!Pervasives.( || )} should be used instead. +(** @deprecated {!Stdlib.( || )} should be used instead. Right-associative operator at precedence level 2/11. *) (** {1 Debugging} *) @@ -524,13 +517,13 @@ external modf : float -> float * float = "caml_modf_float" part of [f]. *) external float : int -> float = "%floatofint" -(** Same as {!Pervasives.float_of_int}. *) +(** Same as {!Stdlib.float_of_int}. *) external float_of_int : int -> float = "%floatofint" (** Convert an integer to floating-point. *) external truncate : float -> int = "%intoffloat" -(** Same as {!Pervasives.int_of_float}. *) +(** Same as {!Stdlib.int_of_float}. *) external int_of_float : float -> int = "%intoffloat" (** Truncate the given floating-point number to an integer. @@ -568,7 +561,7 @@ type fpclass = | FP_infinite (** Number is positive or negative infinity *) | FP_nan (** Not a number: result of an undefined operation *) (** The five classes of floating-point numbers, as determined by - the {!Pervasives.classify_float} function. *) + the {!Stdlib.classify_float} function. *) external classify_float : (float [@unboxed]) -> fpclass = "caml_classify_float" "caml_classify_float_unboxed" [@@noalloc] @@ -626,7 +619,7 @@ val bool_of_string_opt: string -> bool option *) val bool_of_string : string -> bool -(** Same as {!Pervasives.bool_of_string_opt}, but raise +(** Same as {!Stdlib.bool_of_string_opt}, but raise [Invalid_argument "bool_of_string"] instead of returning [None]. *) val string_of_int : int -> string @@ -654,7 +647,7 @@ val int_of_string_opt: string -> int option *) external int_of_string : string -> int = "caml_int_of_string" -(** Same as {!Pervasives.int_of_string_opt}, but raise +(** Same as {!Stdlib.int_of_string_opt}, but raise [Failure "int_of_string"] instead of returning [None]. *) val string_of_float : float -> string @@ -685,7 +678,7 @@ val float_of_string_opt: string -> float option *) external float_of_string : string -> float = "caml_float_of_string" -(** Same as {!Pervasives.float_of_string_opt}, but raise +(** Same as {!Stdlib.float_of_string_opt}, but raise [Failure "float_of_string"] instead of returning [None]. *) (** {1 Pair operations} *) @@ -798,7 +791,7 @@ val read_int_opt: unit -> int option *) val read_int : unit -> int -(** Same as {!Pervasives.read_int_opt}, but raise [Failure "int_of_string"] +(** Same as {!Stdlib.read_int_opt}, but raise [Failure "int_of_string"] instead of returning [None]. *) val read_float_opt: unit -> float option @@ -811,7 +804,7 @@ val read_float_opt: unit -> float option *) val read_float : unit -> float -(** Same as {!Pervasives.read_float_opt}, but raise [Failure "float_of_string"] +(** Same as {!Stdlib.read_float_opt}, but raise [Failure "float_of_string"] instead of returning [None]. *) @@ -827,8 +820,8 @@ type open_flag = | Open_binary (** open in binary mode (no conversion). *) | Open_text (** open in text mode (may perform conversions). *) | Open_nonblock (** open in non-blocking mode. *) -(** Opening modes for {!Pervasives.open_out_gen} and - {!Pervasives.open_in_gen}. *) +(** Opening modes for {!Stdlib.open_out_gen} and + {!Stdlib.open_in_gen}. *) val open_out : string -> out_channel (** Open the named file for writing, and return a new output channel @@ -837,17 +830,17 @@ val open_out : string -> out_channel is created if it does not already exists. *) val open_out_bin : string -> out_channel -(** Same as {!Pervasives.open_out}, but the file is opened in binary mode, +(** Same as {!Stdlib.open_out}, but the file is opened in binary mode, so that no translation takes place during writes. On operating systems that do not distinguish between text mode and binary - mode, this function behaves like {!Pervasives.open_out}. *) + mode, this function behaves like {!Stdlib.open_out}. *) val open_out_gen : open_flag list -> int -> string -> out_channel (** [open_out_gen mode perm filename] opens the named file for writing, as described above. The extra argument [mode] specifies the opening mode. The extra argument [perm] specifies the file permissions, in case the file must be created. - {!Pervasives.open_out} and {!Pervasives.open_out_bin} are special + {!Stdlib.open_out} and {!Stdlib.open_out_bin} are special cases of this function. *) val flush : out_channel -> unit @@ -890,15 +883,15 @@ val output_binary_int : out_channel -> int -> unit on the given output channel. The given integer is taken modulo 2{^32}. The only reliable way to read it back is through the - {!Pervasives.input_binary_int} function. The format is compatible across + {!Stdlib.input_binary_int} function. The format is compatible across all machines for a given version of OCaml. *) val output_value : out_channel -> 'a -> unit (** Write the representation of a structured value of any type to a channel. Circularities and sharing inside the value are detected and preserved. The object can be read back, - by the function {!Pervasives.input_value}. See the description of module - {!Marshal} for more information. {!Pervasives.output_value} is equivalent + by the function {!Stdlib.input_value}. See the description of module + {!Marshal} for more information. {!Stdlib.output_value} is equivalent to {!Marshal.to_channel} with an empty list of flags. *) val seek_out : out_channel -> int -> unit @@ -946,16 +939,16 @@ val open_in : string -> in_channel on that file, positioned at the beginning of the file. *) val open_in_bin : string -> in_channel -(** Same as {!Pervasives.open_in}, but the file is opened in binary mode, +(** Same as {!Stdlib.open_in}, but the file is opened in binary mode, so that no translation takes place during reads. On operating systems that do not distinguish between text mode and binary - mode, this function behaves like {!Pervasives.open_in}. *) + mode, this function behaves like {!Stdlib.open_in}. *) val open_in_gen : open_flag list -> int -> string -> in_channel (** [open_in_gen mode perm filename] opens the named file for reading, as described above. The extra arguments [mode] and [perm] specify the opening mode and file permissions. - {!Pervasives.open_in} and {!Pervasives.open_in_bin} are special + {!Stdlib.open_in} and {!Stdlib.open_in_bin} are special cases of this function. *) val input_char : in_channel -> char @@ -981,7 +974,7 @@ val input : in_channel -> bytes -> int -> int -> int no more characters were available at that time, or because the implementation found it convenient to do a partial read; [input] must be called again to read the remaining characters, - if desired. (See also {!Pervasives.really_input} for reading + if desired. (See also {!Stdlib.really_input} for reading exactly [len] characters.) Exception [Invalid_argument "input"] is raised if [pos] and [len] do not designate a valid range of [buf]. *) @@ -1002,19 +995,19 @@ val really_input_string : in_channel -> int -> string @since 4.02.0 *) val input_byte : in_channel -> int -(** Same as {!Pervasives.input_char}, but return the 8-bit integer representing +(** Same as {!Stdlib.input_char}, but return the 8-bit integer representing the character. Raise [End_of_file] if an end of file was reached. *) val input_binary_int : in_channel -> int (** Read an integer encoded in binary format (4 bytes, big-endian) - from the given input channel. See {!Pervasives.output_binary_int}. + from the given input channel. See {!Stdlib.output_binary_int}. Raise [End_of_file] if an end of file was reached while reading the integer. *) val input_value : in_channel -> 'a (** Read the representation of a structured value, as produced - by {!Pervasives.output_value}, and return the corresponding value. + by {!Stdlib.output_value}, and return the corresponding value. This function is identical to {!Marshal.from_channel}; see the description of module {!Marshal} for more information, in particular concerning the lack of type safety. *) @@ -1223,7 +1216,7 @@ val at_exit : (unit -> unit) -> unit (** Register the given function to be called at program termination time. The functions registered with [at_exit] will be called when the program does any of the following: - - executes {!Pervasives.exit} + - executes {!Stdlib.exit} - terminates, either normally or because of an uncaught exception - executes the C function [caml_shutdown]. @@ -1239,9 +1232,6 @@ val valid_float_lexem : string -> string val unsafe_really_input : in_channel -> bytes -> int -> int -> unit val do_at_exit : unit -> unit -end - -include module type of struct include Pervasives end (*MODULE_ALIASES*) module Arg = Arg @@ -1276,6 +1266,8 @@ module Obj = Obj module Oo = Oo module Option = Option module Parsing = Parsing +module Pervasives = Pervasives +[@@deprecated "Use Stdlib instead."] module Printexc = Printexc module Printf = Printf module Queue = Queue diff --git a/stdlib/string.ml b/stdlib/string.ml index aeac43236..f39273e7d 100644 --- a/stdlib/string.ml +++ b/stdlib/string.ml @@ -199,7 +199,7 @@ let uncapitalize_ascii s = type t = string -let compare (x: t) (y: t) = Pervasives.compare x y +let compare (x: t) (y: t) = Stdlib.compare x y external equal : string -> string -> bool = "caml_string_equal" let split_on_char sep s = diff --git a/stdlib/string.mli b/stdlib/string.mli index 8ec3fff89..29bfc7fca 100644 --- a/stdlib/string.mli +++ b/stdlib/string.mli @@ -310,7 +310,7 @@ type t = string val compare: t -> t -> int (** The comparison function for strings, with the same specification as - {!Pervasives.compare}. Along with the type [t], this function [compare] + {!Stdlib.compare}. Along with the type [t], this function [compare] allows the module [String] to be passed as argument to the functors {!Set.Make} and {!Map.Make}. *) diff --git a/stdlib/stringLabels.mli b/stdlib/stringLabels.mli index dac714cb0..4001707d3 100644 --- a/stdlib/stringLabels.mli +++ b/stdlib/stringLabels.mli @@ -265,7 +265,7 @@ type t = string val compare: t -> t -> int (** The comparison function for strings, with the same specification as - {!Pervasives.compare}. Along with the type [t], this function [compare] + {!Stdlib.compare}. Along with the type [t], this function [compare] allows the module [String] to be passed as argument to the functors {!Set.Make} and {!Map.Make}. *) diff --git a/stdlib/uchar.ml b/stdlib/uchar.ml index e4a40f65b..f48e1b10f 100644 --- a/stdlib/uchar.ml +++ b/stdlib/uchar.ml @@ -54,5 +54,5 @@ let to_char u = let unsafe_to_char = Char.unsafe_chr let equal : int -> int -> bool = ( = ) -let compare : int -> int -> int = Pervasives.compare +let compare : int -> int -> int = Stdlib.compare let hash = to_int diff --git a/stdlib/uchar.mli b/stdlib/uchar.mli index afab670f9..8ce7a35a5 100644 --- a/stdlib/uchar.mli +++ b/stdlib/uchar.mli @@ -92,7 +92,7 @@ val equal : t -> t -> bool (** [equal u u'] is [u = u']. *) val compare : t -> t -> int -(** [compare u u'] is [Pervasives.compare u u']. *) +(** [compare u u'] is [Stdlib.compare u u']. *) val hash : t -> int (** [hash u] associates a non-negative integer to [u]. *) diff --git a/stdlib/weak.mli b/stdlib/weak.mli index 842520aa1..5043be1a4 100644 --- a/stdlib/weak.mli +++ b/stdlib/weak.mli @@ -30,7 +30,7 @@ type 'a t Notes: - Integers are not allocated and cannot be stored in weak arrays. - - Weak arrays cannot be marshaled using {!Pervasives.output_value} + - Weak arrays cannot be marshaled using {!Stdlib.output_value} nor the functions of the {!Marshal} module. *) @@ -114,7 +114,7 @@ module type S = sig type t (** The type of tables that contain elements of type [data]. Note that weak hash sets cannot be marshaled using - {!Pervasives.output_value} or the functions of the {!Marshal} + {!Stdlib.output_value} or the functions of the {!Marshal} module. *) val create : int -> t diff --git a/testsuite/tests/asmcomp/is_static_flambda.ml b/testsuite/tests/asmcomp/is_static_flambda.ml index de395c699..7ddf7e92d 100644 --- a/testsuite/tests/asmcomp/is_static_flambda.ml +++ b/testsuite/tests/asmcomp/is_static_flambda.ml @@ -67,9 +67,9 @@ let i () = let () = (i [@inlined never]) () -module type P = module type of Pervasives +module type P = module type of Stdlib (* Top-level modules should be static *) -let () = assert(is_in_static_data (module Pervasives:P)) +let () = assert(is_in_static_data (module Stdlib:P)) (* Not constant let rec to test extraction to initialize_symbol *) let r = ref 0 diff --git a/testsuite/tests/backtrace/backtrace_slots.ml b/testsuite/tests/backtrace/backtrace_slots.ml index ef68b3fde..15bbb1ef6 100644 --- a/testsuite/tests/backtrace/backtrace_slots.ml +++ b/testsuite/tests/backtrace/backtrace_slots.ml @@ -25,7 +25,7 @@ let get_backtrace () = Array.iteri (fun i slot -> Hashtbl.add table slot i) raw_slots; let module S = Set.Make(struct type t = Printexc.raw_backtrace_slot - let compare = Pervasives.compare + let compare = Stdlib.compare end) in let slots = Array.fold_right S.add raw_slots S.empty in Array.iteri (fun i slot -> diff --git a/testsuite/tests/backtrace/pr6920_why_at.byte.reference b/testsuite/tests/backtrace/pr6920_why_at.byte.reference index 442859556..5fdde076f 100644 --- a/testsuite/tests/backtrace/pr6920_why_at.byte.reference +++ b/testsuite/tests/backtrace/pr6920_why_at.byte.reference @@ -1,4 +1,4 @@ -Fatal error: exception Stdlib.Pervasives.Exit +Fatal error: exception Stdlib.Exit Raised at file "pr6920_why_at.ml", line 13, characters 41-45 Called from file "pr6920_why_at.ml", line 15, characters 2-11 Called from file "pr6920_why_at.ml", line 21, characters 2-6 diff --git a/testsuite/tests/backtrace/pr6920_why_at.native.reference b/testsuite/tests/backtrace/pr6920_why_at.native.reference new file mode 100644 index 000000000..e69de29bb diff --git a/testsuite/tests/backtrace/pr6920_why_at.opt.reference b/testsuite/tests/backtrace/pr6920_why_at.opt.reference index 62a0ef962..076f29ae5 100644 --- a/testsuite/tests/backtrace/pr6920_why_at.opt.reference +++ b/testsuite/tests/backtrace/pr6920_why_at.opt.reference @@ -1,4 +1,4 @@ -Fatal error: exception Stdlib.Pervasives.Exit +Fatal error: exception Stdlib.Exit Raised at file "pr6920_why_at.ml", line 13, characters 35-45 Called from file "pr6920_why_at.ml", line 15, characters 2-11 Called from file "pr6920_why_at.ml", line 21, characters 2-6 diff --git a/testsuite/tests/backtrace/pr6920_why_swallow.byte.reference b/testsuite/tests/backtrace/pr6920_why_swallow.byte.reference index c262211d5..f967fa7a5 100644 --- a/testsuite/tests/backtrace/pr6920_why_swallow.byte.reference +++ b/testsuite/tests/backtrace/pr6920_why_swallow.byte.reference @@ -1,4 +1,4 @@ -Fatal error: exception Stdlib.Pervasives.Exit +Fatal error: exception Stdlib.Exit Raised at file "pr6920_why_swallow.ml", line 13, characters 41-45 Called from file "pr6920_why_swallow.ml", line 16, characters 4-13 Called from file "pr6920_why_swallow.ml", line 23, characters 2-6 diff --git a/testsuite/tests/backtrace/pr6920_why_swallow.native.reference b/testsuite/tests/backtrace/pr6920_why_swallow.native.reference new file mode 100644 index 000000000..e69de29bb diff --git a/testsuite/tests/backtrace/pr6920_why_swallow.opt.reference b/testsuite/tests/backtrace/pr6920_why_swallow.opt.reference index b842cee04..48b4b05a1 100644 --- a/testsuite/tests/backtrace/pr6920_why_swallow.opt.reference +++ b/testsuite/tests/backtrace/pr6920_why_swallow.opt.reference @@ -1,4 +1,4 @@ -Fatal error: exception Stdlib.Pervasives.Exit +Fatal error: exception Stdlib.Exit Raised at file "pr6920_why_swallow.ml", line 13, characters 35-45 Called from file "pr6920_why_swallow.ml", line 16, characters 4-13 Called from file "pr6920_why_swallow.ml", line 23, characters 2-6 diff --git a/testsuite/tests/basic-float/zero_sized_float_arrays.ml b/testsuite/tests/basic-float/zero_sized_float_arrays.ml index b207b8284..51657d3e9 100644 --- a/testsuite/tests/basic-float/zero_sized_float_arrays.ml +++ b/testsuite/tests/basic-float/zero_sized_float_arrays.ml @@ -11,7 +11,7 @@ let float_array_from_runtime : float array = Array.make 0 0.0 let () = - assert (Pervasives.compare non_float_array non_float_array_from_runtime = 0); - assert (Pervasives.compare non_float_array non_float_array_from_runtime = 0); - assert (Pervasives.compare float_array float_array_from_runtime = 0); - assert (Pervasives.compare float_array float_array_from_runtime = 0) + assert (Stdlib.compare non_float_array non_float_array_from_runtime = 0); + assert (Stdlib.compare non_float_array non_float_array_from_runtime = 0); + assert (Stdlib.compare float_array float_array_from_runtime = 0); + assert (Stdlib.compare float_array float_array_from_runtime = 0) diff --git a/testsuite/tests/float-unboxing/float_subst_boxed_number.ml b/testsuite/tests/float-unboxing/float_subst_boxed_number.ml index bf9a93f29..c8c072733 100644 --- a/testsuite/tests/float-unboxing/float_subst_boxed_number.ml +++ b/testsuite/tests/float-unboxing/float_subst_boxed_number.ml @@ -122,7 +122,7 @@ let unbox_record_1 record = let block = { record with int32 = record.int32 } in for i = 1 to 1000 do let y_float = - if i mod 2 = 0 then nan else Pervasives.float i + if i mod 2 = 0 then nan else Stdlib.float i in block.float <- block.float +. (y_float *. 2.); let y_int32 = diff --git a/testsuite/tests/letrec-check/basic.ml b/testsuite/tests/letrec-check/basic.ml index df746a0d2..edc9bc165 100644 --- a/testsuite/tests/letrec-check/basic.ml +++ b/testsuite/tests/letrec-check/basic.ml @@ -275,21 +275,21 @@ let rec _x = let _ = [| 1.0 |] in 1. in ();; - : unit = () |}];; -(* The builtin Pervasives.ref is currently treated as a constructor. +(* The builtin Stdlib.ref is currently treated as a constructor. Other functions of the same name should not be so treated. *) let _ = - let module Pervasives = + let module Stdlib = struct let ref _ = assert false end in - let rec x = Pervasives.ref y + let rec x = Stdlib.ref y and y = fun () -> ignore x in (x, y) ;; [%%expect{| -Line 6, characters 14-30: - let rec x = Pervasives.ref y - ^^^^^^^^^^^^^^^^ +Line 6, characters 14-26: + let rec x = Stdlib.ref y + ^^^^^^^^^^^^ Error: This kind of expression is not allowed as right-hand side of `let rec' |}];; diff --git a/testsuite/tests/lib-hashtbl/htbl.ml b/testsuite/tests/lib-hashtbl/htbl.ml index 8ee9816b4..df2e48acf 100644 --- a/testsuite/tests/lib-hashtbl/htbl.ml +++ b/testsuite/tests/lib-hashtbl/htbl.ml @@ -35,12 +35,12 @@ module Test(H: Hashtbl.S) (M: Map.S with type key = H.key) = struct let to_list_ h : _ list = H.fold (fun k v acc -> (k,v) :: acc) h [] - |> List.sort Pervasives.compare + |> List.sort Stdlib.compare let check_to_seq h = let l = to_list_ h in let l2 = List.of_seq (H.to_seq h) in - assert (l = List.sort Pervasives.compare l2) + assert (l = List.sort Stdlib.compare l2) let check_to_seq_of_seq h = let h' = H.create (H.length h) in @@ -83,31 +83,31 @@ end module SS = struct type t = string - let compare (x:t) (y:t) = Pervasives.compare x y + let compare (x:t) (y:t) = Stdlib.compare x y let equal (x:t) (y:t) = x=y let hash = Hashtbl.hash end module SI = struct type t = int - let compare (x:t) (y:t) = Pervasives.compare x y + let compare (x:t) (y:t) = Stdlib.compare x y let equal (x:t) (y:t) = x=y let hash = Hashtbl.hash end module SSP = struct type t = string*string - let compare (x:t) (y:t) = Pervasives.compare x y + let compare (x:t) (y:t) = Stdlib.compare x y let equal (x:t) (y:t) = x=y let hash = Hashtbl.hash end module SSL = struct type t = string list - let compare (x:t) (y:t) = Pervasives.compare x y + let compare (x:t) (y:t) = Stdlib.compare x y let equal (x:t) (y:t) = x=y let hash = Hashtbl.hash end module SSA = struct type t = string array - let compare (x:t) (y:t) = Pervasives.compare x y + let compare (x:t) (y:t) = Stdlib.compare x y let equal (x:t) (y:t) = x=y let hash = Hashtbl.hash end diff --git a/testsuite/tests/lib-stdlib/ocamltests b/testsuite/tests/lib-stdlib/ocamltests new file mode 100644 index 000000000..a1f50ef4a --- /dev/null +++ b/testsuite/tests/lib-stdlib/ocamltests @@ -0,0 +1 @@ +pervasives_deprecated.ml diff --git a/testsuite/tests/lib-stdlib/pervasives_deprecated.ml b/testsuite/tests/lib-stdlib/pervasives_deprecated.ml new file mode 100644 index 000000000..c1d3b5a96 --- /dev/null +++ b/testsuite/tests/lib-stdlib/pervasives_deprecated.ml @@ -0,0 +1,32 @@ +(* TEST + * expect +*) + +[@@@warning "@A"];; + +Pervasives.(+) 1 1;; +[%%expect{| +Line 3, characters 0-14: + Pervasives.(+) 1 1;; + ^^^^^^^^^^^^^^ +Error (warning 3): deprecated: module Stdlib.Pervasives +Use Stdlib instead. +|}] + +module X = Pervasives;; +[%%expect{| +Line 1, characters 11-21: + module X = Pervasives;; + ^^^^^^^^^^ +Error (warning 3): deprecated: module Stdlib.Pervasives +Use Stdlib instead. +|}] + +open Pervasives;; +[%%expect{| +Line 1, characters 5-15: + open Pervasives;; + ^^^^^^^^^^ +Error (warning 3): deprecated: module Stdlib.Pervasives +Use Stdlib instead. +|}] diff --git a/testsuite/tests/parsetree/source.ml b/testsuite/tests/parsetree/source.ml index 3cdb23dfe..d6814e654 100644 --- a/testsuite/tests/parsetree/source.ml +++ b/testsuite/tests/parsetree/source.ml @@ -4161,7 +4161,7 @@ module Make(O : Set.OrderedType) : S with type elt = O.t = module rec A : Set.OrderedType = struct type t = int - let compare = Pervasives.compare + let compare = Stdlib.compare end and B : S = struct module C = Make(A) @@ -5763,7 +5763,7 @@ module rec A type t = Leaf of int | Node of ASet.t let compare x y = match (x,y) with - (Leaf i, Leaf j) -> Pervasives.compare i j + (Leaf i, Leaf j) -> Stdlib.compare i j | (Leaf i, Node t) -> -1 | (Node s, Leaf j) -> 1 | (Node s, Node t) -> ASet.compare s t diff --git a/testsuite/tests/tool-ocaml/t240-c_call1.ml b/testsuite/tests/tool-ocaml/t240-c_call1.ml index 0b0bfd41a..b1be841f0 100644 --- a/testsuite/tests/tool-ocaml/t240-c_call1.ml +++ b/testsuite/tests/tool-ocaml/t240-c_call1.ml @@ -7,9 +7,9 @@ ocaml_script_as_argument = "true" *) open Lib;; -if Pervasives.int_of_string "123" <> 123 then raise Not_found;; +if Stdlib.int_of_string "123" <> 123 then raise Not_found;; (** test for fix of bug 6649: http://caml.inria.fr/mantis/view.php?id=6649 *) -if Pervasives.int_of_string "+123" <> 123 then raise Not_found;; +if Stdlib.int_of_string "+123" <> 123 then raise Not_found;; if Int32.of_string "+123" <> Int32.of_int 123 then raise Not_found;; if Int64.of_string "+123" <> Int64.of_int 123 then raise Not_found;; diff --git a/testsuite/tests/typing-modules-bugs/pr6572_ok.ml b/testsuite/tests/typing-modules-bugs/pr6572_ok.ml index 8f9647bc2..94cd21c53 100644 --- a/testsuite/tests/typing-modules-bugs/pr6572_ok.ml +++ b/testsuite/tests/typing-modules-bugs/pr6572_ok.ml @@ -18,7 +18,7 @@ module Make(O : Set.OrderedType) : S with type elt = O.t = module rec A : Set.OrderedType = struct type t = int - let compare = Pervasives.compare + let compare = Stdlib.compare end and B : S = struct module C = Make(A) diff --git a/testsuite/tests/typing-poly/poly.ml b/testsuite/tests/typing-poly/poly.ml index c0e664833..c290efb92 100644 --- a/testsuite/tests/typing-poly/poly.ml +++ b/testsuite/tests/typing-poly/poly.ml @@ -1423,7 +1423,7 @@ let {foo} = (raise Exit : t);; type s = A of int let (A x) = (raise Exit : s);; [%%expect {| -Exception: Stdlib.Pervasives.Exit. +Exception: Stdlib.Exit. |}];; (* PR#5224 *) diff --git a/testsuite/tests/typing-recmod/t22ok.ml b/testsuite/tests/typing-recmod/t22ok.ml index bfc119f4b..16e9cbcfe 100644 --- a/testsuite/tests/typing-recmod/t22ok.ml +++ b/testsuite/tests/typing-recmod/t22ok.ml @@ -24,7 +24,7 @@ module rec A type t = Leaf of int | Node of ASet.t let compare x y = match (x,y) with - (Leaf i, Leaf j) -> Pervasives.compare i j + (Leaf i, Leaf j) -> Stdlib.compare i j | (Leaf i, Node t) -> -1 | (Node s, Leaf j) -> 1 | (Node s, Node t) -> ASet.compare s t diff --git a/testsuite/tests/typing-warnings/application.ml b/testsuite/tests/typing-warnings/application.ml index 31715bd7c..213f2fdb4 100644 --- a/testsuite/tests/typing-warnings/application.ml +++ b/testsuite/tests/typing-warnings/application.ml @@ -25,5 +25,5 @@ Line 1, characters 19-20: let _ = raise Exit 3;; ^ Warning 20: this argument will not be used by the function. -Exception: Stdlib.Pervasives.Exit. +Exception: Stdlib.Exit. |}] diff --git a/testsuite/tests/typing-warnings/pr7297.compilers.reference b/testsuite/tests/typing-warnings/pr7297.compilers.reference new file mode 100644 index 000000000..14402e754 --- /dev/null +++ b/testsuite/tests/typing-warnings/pr7297.compilers.reference @@ -0,0 +1,7 @@ +- : unit = () +Characters 10-20: + let () = raise Exit; () ;; (* warn *) + ^^^^^^^^^^ +Warning 21: this statement never returns (or has an unsound type.) +Exception: Stdlib.Exit. + diff --git a/testsuite/tests/typing-warnings/pr7297.ml b/testsuite/tests/typing-warnings/pr7297.ml index aff3152a8..f1aea8074 100644 --- a/testsuite/tests/typing-warnings/pr7297.ml +++ b/testsuite/tests/typing-warnings/pr7297.ml @@ -15,5 +15,5 @@ Line 1, characters 9-19: let () = raise Exit; () ;; (* warn *) ^^^^^^^^^^ Warning 21: this statement never returns (or has an unsound type.) -Exception: Stdlib.Pervasives.Exit. +Exception: Stdlib.Exit. |}] diff --git a/tools/objinfo.ml b/tools/objinfo.ml index 66973bb74..adb545384 100644 --- a/tools/objinfo.ml +++ b/tools/objinfo.ml @@ -209,7 +209,7 @@ let p_list title print = function let dump_byte ic = Bytesections.read_toc ic; let toc = Bytesections.toc () in - let toc = List.sort Pervasives.compare toc in + let toc = List.sort Stdlib.compare toc in List.iter (fun (section, _) -> try diff --git a/toplevel/opttoploop.ml b/toplevel/opttoploop.ml index 7466c6c74..1191c86f2 100644 --- a/toplevel/opttoploop.ml +++ b/toplevel/opttoploop.ml @@ -464,12 +464,12 @@ let first_line = ref true let got_eof = ref false;; let read_input_default prompt buffer len = - output_string Pervasives.stdout prompt; flush Pervasives.stdout; + output_string stdout prompt; flush stdout; let i = ref 0 in try while true do if !i >= len then raise Exit; - let c = input_char Pervasives.stdin in + let c = input_char stdin in Bytes.set buffer !i c; incr i; if c = '\n' then raise Exit; diff --git a/toplevel/toploop.ml b/toplevel/toploop.ml index d8f759752..ed6e44359 100644 --- a/toplevel/toploop.ml +++ b/toplevel/toploop.ml @@ -414,12 +414,12 @@ let first_line = ref true let got_eof = ref false;; let read_input_default prompt buffer len = - output_string Pervasives.stdout prompt; flush Pervasives.stdout; + output_string stdout prompt; flush stdout; let i = ref 0 in try while true do if !i >= len then raise Exit; - let c = input_char Pervasives.stdin in + let c = input_char stdin in Bytes.set buffer !i c; incr i; if c = '\n' then raise Exit; diff --git a/typing/ident.ml b/typing/ident.ml index dd7c63f4a..550d0ac69 100644 --- a/typing/ident.ml +++ b/typing/ident.ml @@ -61,7 +61,7 @@ let same i1 i2 = i1 = i2 then i1.stamp = i2.stamp else i2.stamp = 0 && i1.name = i2.name *) -let compare i1 i2 = Pervasives.compare i1 i2 +let compare i1 i2 = Stdlib.compare i1 i2 let binding_time i = i.stamp diff --git a/typing/includemod.ml b/typing/includemod.ml index b98111e62..7fb1bcb96 100644 --- a/typing/includemod.ml +++ b/typing/includemod.ml @@ -171,7 +171,7 @@ let kind_of_field_desc = function such as values and types. *) module FieldMap = Map.Make(struct type t = field_desc - let compare = Pervasives.compare + let compare = Stdlib.compare end) let item_ident_name = function diff --git a/typing/parmatch.ml b/typing/parmatch.ml index da45568b3..c7ffba145 100644 --- a/typing/parmatch.ml +++ b/typing/parmatch.ml @@ -246,7 +246,7 @@ let is_absent_pat p = match p.pat_desc with let const_compare x y = match x,y with | Const_float f1, Const_float f2 -> - Pervasives.compare (float_of_string f1) (float_of_string f2) + Stdlib.compare (float_of_string f1) (float_of_string f2) | Const_string (s1, _), Const_string (s2, _) -> String.compare s1 s2 | (Const_int _ @@ -256,7 +256,7 @@ let const_compare x y = |Const_int32 _ |Const_int64 _ |Const_nativeint _ - ), _ -> Pervasives.compare x y + ), _ -> Stdlib.compare x y let records_args l1 l2 = (* Invariant: fields are already sorted by Typecore.type_label_a_list *) diff --git a/typing/parmatch.mli b/typing/parmatch.mli index 3dc5489fc..000b02b4d 100644 --- a/typing/parmatch.mli +++ b/typing/parmatch.mli @@ -34,7 +34,7 @@ val normalize_pat : pattern -> pattern val const_compare : constant -> constant -> int (** [const_compare c1 c2] compares the actual values represented by [c1] and - [c2], while simply using [Pervasives.compare] would compare the + [c2], while simply using [Stdlib.compare] would compare the representations. cf. MPR#5758 *) diff --git a/typing/printtyp.ml b/typing/printtyp.ml index 4bc655f68..38f513632 100644 --- a/typing/printtyp.ml +++ b/typing/printtyp.ml @@ -141,7 +141,7 @@ module Conflicts = struct let take () = let c = !explanations in reset (); - c |> M.bindings |> List.map snd |> List.sort Pervasives.compare + c |> M.bindings |> List.map snd |> List.sort Stdlib.compare let print ppf = let sep ppf = Format.fprintf ppf "@ " in @@ -181,8 +181,8 @@ type mapping = *) | Associated_to_pervasives of out_name (** [Associated_to_pervasives out_name] is used when the item - [Pervasives.$name] has been associated to the name [$name]. - Upon a conflict, this name will be expanded to ["Pervasives." ^ name ] *) + [Stdlib.$name] has been associated to the name [$name]. + Upon a conflict, this name will be expanded to ["Stdlib." ^ name ] *) let hid_start = 0 @@ -194,7 +194,7 @@ let find_hid id map = try N.find (Ident.binding_time id) map, map with Not_found -> add_hid_id id map -let pervasives name = "Pervasives." ^ name +let pervasives name = "Stdlib." ^ name let map = Array.make Namespace.size M.empty let get namespace = map.(Namespace.id namespace) @@ -252,7 +252,7 @@ let ident_name_simple namespace id = set namespace @@ M.add name (Need_unique_name m) (get namespace); Out_name.create (human_unique hid id) | Associated_to_pervasives r -> - Out_name.set r ("Pervasives." ^ Out_name.print r); + Out_name.set r ("Stdlib." ^ Out_name.print r); let hid, m = find_hid id N.empty in set namespace @@ M.add name (Need_unique_name m) (get namespace); Out_name.create (human_unique hid id) @@ -290,21 +290,6 @@ let non_shadowed_pervasive = function Ident.same id ident_stdlib && (try Path.same path (Env.lookup_type (Lident s) !printing_env) with Not_found -> true) - | Pdot(Pdot (Pident id, "Pervasives", _), s, _) as path -> - Ident.same id ident_stdlib && - (* Make sure Stdlib. is the same as Stdlib.Pervasives. *) - (try - let td = - Env.find_type (Env.lookup_type (Lident s) !printing_env) - !printing_env - in - match td.type_private, td.type_manifest with - | Private, _ | _, None -> false - | Public, Some te -> - match (Btype.repr te).desc with - | Tconstr (path', _, _) -> Path.same path path' - | _ -> false - with Not_found -> true) | _ -> false let find_double_underscore s = diff --git a/typing/typecore.ml b/typing/typecore.ml index 5c9fc192f..ccd931d1e 100644 --- a/typing/typecore.ml +++ b/typing/typecore.ml @@ -512,7 +512,7 @@ let enter_variable ?(is_module=false) ?(is_as_variable=false) loc name ty let sort_pattern_variables vs = List.sort (fun {pv_id = x; _} {pv_id = y; _} -> - Pervasives.compare (Ident.name x) (Ident.name y)) + Stdlib.compare (Ident.name x) (Ident.name y)) vs let enter_orpat_variables loc env p1_vs p2_vs = diff --git a/utils/misc.ml b/utils/misc.ml index ba2cb6f4f..dfea72d51 100644 --- a/utils/misc.ml +++ b/utils/misc.ml @@ -208,6 +208,7 @@ module Stdlib = struct module Map = Map.Make(String) end + external compare : 'a -> 'a -> int = "%compare" end let may = Stdlib.Option.iter diff --git a/utils/misc.mli b/utils/misc.mli index aa496ebd1..1d4158e92 100644 --- a/utils/misc.mli +++ b/utils/misc.mli @@ -140,6 +140,8 @@ module Stdlib : sig module Set : Set.S with type elt = string module Map : Map.S with type key = string end + + external compare : 'a -> 'a -> int = "%compare" end val find_in_path: string list -> string -> string diff --git a/utils/numbers.ml b/utils/numbers.ml index 3e361e661..18006a5b8 100644 --- a/utils/numbers.ml +++ b/utils/numbers.ml @@ -77,7 +77,7 @@ module Float = struct include Identifiable.Make (struct type t = float - let compare x y = Pervasives.compare x y + let compare x y = Stdlib.compare x y let output oc x = Printf.fprintf oc "%f" x let hash f = Hashtbl.hash f let equal (i : float) j = i = j diff --git a/utils/targetint.mli b/utils/targetint.mli index 788d690f6..2a6c0f6d9 100644 --- a/utils/targetint.mli +++ b/utils/targetint.mli @@ -52,7 +52,7 @@ val mul : t -> t -> t val div : t -> t -> t (** Integer division. Raise [Division_by_zero] if the second argument is zero. This division rounds the real quotient of - its arguments towards zero, as specified for {!Pervasives.(/)}. *) + its arguments towards zero, as specified for {!Stdlib.(/)}. *) val rem : t -> t -> t (** Integer remainder. If [y] is not zero, the result @@ -173,7 +173,7 @@ val to_string : t -> string val compare: t -> t -> int (** The comparison function for target integers, with the same specification as - {!Pervasives.compare}. Along with the type [t], this function [compare] + {!Stdlib.compare}. Along with the type [t], this function [compare] allows the module [Targetint] to be passed as argument to the functors {!Set.Make} and {!Map.Make}. *)