Merge remote-tracking branch 'ocaml/3.12'

Changes

@@ -3,10 +3,14 @@ Objective Caml 3.12.2:
 
 Bug fixes:
 - problem with printing of string literals in camlp4 (reported on caml-list)
+- PR#1643: functions of the Lazy module whose named started with 'lazy_' have
+           been deprecated, and new ones without the prefix added
 - PR#4697: Unix.putenv leaks memory on failure
 - PR#4705: camlp4 does not allow to define types with `True or `False
 - PR#4937: camlp4 incorrectly handles optional arguments if 'option' is redefined
 - PR#5024: camlp4r now handles underscores in irrefutable patern matching of records
+- PR#5211: updated Genlex documentation to state that camlp4 is mandatory for 'parser'
+           keyword and associated notation
 - PR#5238, PR#5277: Sys_error when getting error location
 - PR#5301: camlp4r and exception equal to another one with parameters
 - PR#5316: objinfo now shows ccopts/ccobjs/force_link when applicable
@@ -16,6 +20,11 @@ Bug fixes:
 - PR#5335: Unix.environment segfaults after a call to clearenv
 - PR#5344: some predifined exceptions need special printing
 
+Feature wishes:
+- PR#4444: new String.trim function, removing leading and trailing whistespace
+- PR#4898: new Sys.big_endian boolean for machine endianness
+- PR#5236: new '%revapply' primitive with the semantics 'revapply x f = f x'
+
 Objective Caml 3.12.1:
 ----------------------
 

asmcomp/closure.ml

@@ -563,6 +563,8 @@ let rec close fenv cenv = function
         let (ubody, approx) = close fenv_body cenv body in
         (Uletrec(udefs, ubody), approx)
       end
+  | Lprim(Prevapply,[arg;funct]) ->
+      close fenv cenv (Lapply(funct, [arg], Location.none))
   | Lprim(Pgetglobal id, []) as lam ->
       check_constant_result lam
                             (getglobal id)

bytecomp/bytegen.ml

@@ -524,6 +524,9 @@ let rec comp_expr env exp sz cont =
       comp_expr env arg sz cont
   | Lprim(Pignore, [arg]) ->
       comp_expr env arg sz (add_const_unit cont)
+  | Lprim(Prevapply, [arg;func]) ->
+      let exp = Lapply(func, [arg], Location.none) in
+      comp_expr env exp sz cont
   | Lprim(Pnot, [arg]) ->
       let newcont =
         match cont with

bytecomp/lambda.ml

@@ -19,6 +19,7 @@ open Asttypes
 type primitive =
     Pidentity
   | Pignore
+  | Prevapply
     (* Globals *)
   | Pgetglobal of Ident.t
   | Psetglobal of Ident.t

bytecomp/lambda.mli

@@ -19,6 +19,7 @@ open Asttypes
 type primitive =
     Pidentity
   | Pignore
+  | Prevapply
     (* Globals *)
   | Pgetglobal of Ident.t
   | Psetglobal of Ident.t

bytecomp/printlambda.ml

@@ -92,6 +92,7 @@ let record_rep ppf r =
 let primitive ppf = function
   | Pidentity -> fprintf ppf "id"
   | Pignore -> fprintf ppf "ignore"
+  | Prevapply -> fprintf ppf "revapply"
   | Pgetglobal id -> fprintf ppf "global %a" Ident.print id
   | Psetglobal id -> fprintf ppf "setglobal %a" Ident.print id
   | Pmakeblock(tag, Immutable) -> fprintf ppf "makeblock %i" tag

bytecomp/translcore.ml

@@ -143,6 +143,7 @@ let comparisons_table = create_hashtable 11 [
 let primitives_table = create_hashtable 57 [
   "%identity", Pidentity;
   "%ignore", Pignore;
+  "%revapply",Prevapply;
   "%field0", Pfield 0;
   "%field1", Pfield 1;
   "%setfield0", Psetfield(0, true);

byterun/sys.c

@@ -324,9 +324,14 @@ CAMLprim value caml_sys_get_config(value unit)
   CAMLlocal2 (result, ostype);
 
   ostype = caml_copy_string(OCAML_OS_TYPE);
-  result = caml_alloc_small (2, 0);
+  result = caml_alloc_small (3, 0);
   Field(result, 0) = ostype;
   Field(result, 1) = Val_long (8 * sizeof(value));
+#ifdef ARCH_BIG_ENDIAN
+  Field(result, 2) = Val_true;
+#else
+  Field(result, 2) = Val_false;
+#endif
   CAMLreturn (result);
 }
 

config/Makefile.mingw

@@ -65,6 +65,7 @@ ASM=as
 ASPP=gcc
 ASPPPROFFLAGS=
 PROFILING=noprof
+RUNTIMED=noruntimed
 DYNLINKOPTS=
 DEBUGGER=ocamldebugger
 CC_PROFILE=

otherlibs/labltk/support/Makefile

@@ -16,9 +16,10 @@ CCFLAGS=-I../../../byterun $(TK_DEFS) $(SHAREDCCCOMPOPTS)
 
 COMPFLAGS=-I $(OTHERS)/win32unix -I $(OTHERS)/unix
 THFLAGS=-I $(OTHERS)/systhreads -I $(OTHERS)/threads
+TKLDOPTS=$(TK_LINK:%=-ldopt "%")
 
 lib$(LIBNAME).$(A): $(COBJS)
-	$(MKLIB) -o $(LIBNAME) $(COBJS) -ldopt "$(TK_LINK)"
+	$(MKLIB) -o $(LIBNAME) $(COBJS) $(TKLDOPTS)
 
 PUBMLI=fileevent.mli protocol.mli textvariable.mli timer.mli \
     rawwidget.mli widget.mli

stdlib/genlex.mli

@@ -37,6 +37,11 @@
                   [< 'Kwd "+"; n2 = parse_expr >] -> n1+n2
                 | ...
    ]}
+
+   One should notice that the use of the [parser] keyword and associated
+   notation for streams are only available through camlp4 extensions. This
+   means that one has to preprocess its sources {i e. g.} by using the
+   ["-pp"] command-line switch of the compilers.
 *)
 
 (** The type of tokens. The lexical classes are: [Int] and [Float]

stdlib/lazy.ml

@@ -57,13 +57,13 @@ external force : 'a t -> 'a = "%lazy_force";;
 
 let force_val = CamlinternalLazy.force_val;;
 
-let lazy_from_fun (f : unit -> 'arg) =
+let from_fun (f : unit -> 'arg) =
   let x = Obj.new_block Obj.lazy_tag 1 in
   Obj.set_field x 0 (Obj.repr f);
   (Obj.obj x : 'arg t)
 ;;
 
-let lazy_from_val (v : 'arg) =
+let from_val (v : 'arg) =
   let t = Obj.tag (Obj.repr v) in
   if t = Obj.forward_tag || t = Obj.lazy_tag || t = Obj.double_tag then begin
     make_forward v
@@ -72,4 +72,10 @@ let lazy_from_val (v : 'arg) =
   end
 ;;
 
-let lazy_is_val (l : 'arg t) = Obj.tag (Obj.repr l) <> Obj.lazy_tag;;
+let is_val (l : 'arg t) = Obj.tag (Obj.repr l) <> Obj.lazy_tag;;
+
+let lazy_from_fun = from_fun;;
+
+let lazy_from_val = from_val;;
+
+let lazy_is_val = is_val;;

stdlib/lazy.mli

@@ -62,15 +62,23 @@ val force_val : 'a t -> 'a;;
     whether [force_val x] raises the same exception or [Undefined].
 *)
 
-val lazy_from_fun : (unit -> 'a) -> 'a t;;
-(** [lazy_from_fun f] is the same as [lazy (f ())] but slightly more
-    efficient. *)
+val from_fun : (unit -> 'a) -> 'a t;;
+(** [from_fun f] is the same as [lazy (f ())] but slightly more efficient. *)
 
-val lazy_from_val : 'a -> 'a t;;
-(** [lazy_from_val v] returns an already-forced suspension of [v]
+val from_val : 'a -> 'a t;;
+(** [from_val v] returns an already-forced suspension of [v].
     This is for special purposes only and should not be confused with
     [lazy (v)]. *)
 
-val lazy_is_val : 'a t -> bool;;
-(** [lazy_is_val x] returns [true] if [x] has already been forced and
+val is_val : 'a t -> bool;;
+(** [is_val x] returns [true] if [x] has already been forced and
     did not raise an exception. *)
+
+val lazy_from_fun : (unit -> 'a) -> 'a t;;
+(** @deprecated synonym for [from_fun]. *)
+
+val lazy_from_val : 'a -> 'a t;;
+(** @deprecated synonym for [from_val]. *)
+
+val lazy_is_val : 'a t -> bool;;
+(** @deprecated synonym for [is_val]. *)

stdlib/stdLabels.mli

@@ -117,6 +117,7 @@ module String :
         unit
     val concat : sep:string -> string list -> string
     val iter : f:(char -> unit) -> string -> unit
+    val trim : string -> string
     val escaped : string -> string
     val index : string -> char -> int
     val rindex : string -> char -> int

stdlib/string.ml

@@ -82,6 +82,27 @@ external is_printable: char -> bool = "caml_is_printable"
 external char_code: char -> int = "%identity"
 external char_chr: int -> char = "%identity"
 
+let is_space = function
+  | ' ' | '\012' | '\n' | '\r' | '\t' -> true
+  | _ -> false
+
+let trim s =
+  let len = length s in
+  let i = ref 0 in
+  while !i < len && is_space (unsafe_get s !i) do
+    incr i
+  done;
+  let j = ref (len - 1) in
+  while !j >= !i && is_space (unsafe_get s !j) do
+    decr j
+  done;
+  if !i = 0 && !j = len - 1 then
+    s
+  else if !j >= !i then
+    sub s !i (!j - !i + 1)
+  else
+    ""
+
 let escaped s =
   let n = ref 0 in
     for i = 0 to length s - 1 do

stdlib/string.mli

@@ -94,6 +94,12 @@ val iter : (char -> unit) -> string -> unit
    the characters of [s].  It is equivalent to
    [f s.[0]; f s.[1]; ...; f s.[String.length s - 1]; ()]. *)
 
+val trim : string -> string
+(** Return a copy of the argument, without leading and trailing whitespace.
+   The characters regarded as whitespace are: [' '], ['\012'], ['\n'],
+   ['\r'], and ['\t'].  If there is no whitespace character in the argument,
+   return the original string itself, not a copy. *)
+
 val escaped : string -> string
 (** Return a copy of the argument, with special characters
    represented by escape sequences, following the lexical

stdlib/stringLabels.mli

@@ -84,6 +84,12 @@ val iter : f:(char -> unit) -> string -> unit
    the characters of [s].  It is equivalent to
    [f s.[0]; f s.[1]; ...; f s.[String.length s - 1]; ()]. *)
 
+val trim : string -> string
+(** Return a copy of the argument, without leading and trailing whitespace.
+   The characters regarded as whitespace are: [' '], ['\012'], ['\n'],
+   ['\r'], and ['\t'].  If there is no whitespace character in the argument,
+   return the original string itself, not a copy. *)
+
 val escaped : string -> string
 (** Return a copy of the argument, with special characters
    represented by escape sequences, following the lexical

stdlib/sys.mli

@@ -84,6 +84,9 @@ val word_size : int
 (** Size of one word on the machine currently executing the Caml
    program, in bits: 32 or 64. *)
 
+val big_endian : bool
+(** Whether the machine currently executing the Caml program is big-endian. *)
+
 val max_string_length : int
 (** Maximum length of a string. *)
 

stdlib/sys.mlp

@@ -19,11 +19,11 @@
 
 (* System interface *)
 
-external get_config: unit -> string * int = "caml_sys_get_config"
+external get_config: unit -> string * int * bool = "caml_sys_get_config"
 external get_argv: unit -> string * string array = "caml_sys_get_argv"
 
 let (executable_name, argv) = get_argv()
-let (os_type, word_size) = get_config()
+let (os_type, word_size, big_endian) = get_config()
 let max_array_length = (1 lsl (word_size - 10)) - 1;;
 let max_string_length = word_size / 8 * max_array_length - 1;;