Merge tag 4.03.0 into trunk.

Changes

@@ -382,13 +382,15 @@ Runtime system:
 - GPR#262: Multiple GC roots per compilation unit
   (Pierre Chambart, Mark Shinwell, review by Damien Doligez)
 
-- GPR#297: Several changes to improve the worst-case GC pause time.
+* GPR#297: Several changes to improve the worst-case GC pause time.
-  (Damien Doligez, with help from Leo White and Francois Bobot)
+  Changes Gc.control and Gc.major_slice and adds functions to the Gc module.
+  (Damien Doligez, with help from Francois Bobot, Thomas Braibant, Leo White)
 
 - GPR#325: Add v=0x400 flag to OCAMLRUNPARAM to display GC stats on exit
   (Louis Gesbert, review by Alain Frisch)
 
 Standard library:
+=================
 
 - PR#1460, GPR#230: Array.map2, Array.iter2
   (John Christopher McAlpine)
@@ -610,6 +612,10 @@ Other libraries:
     "end of line" means for "^" and "$" regexps.
   (Xavier Leroy, question by Fredrik Lindgren)
 
+- PR#7209: do not run at_exit handlers in [Unix.create_process] and
+  similar functions when the [exec] call fails in the child process
+  (Jérémie Dimino)
+
 OCamldep:
 =========
 
@@ -630,6 +636,9 @@ Manual:
 - PR#6676: ongoing simplification of the "Language Extensions" section
   (Alain Frisch, John Whitington)
 
+- PR#6898: Update win32 support documentation of the Unix library
+  (Damien Doligez, report by Daniel Bünzli)
+
 - PR#7092, GPR#379: Add missing documentation for new 4.03 features
   (Florian Angeletti)
 
@@ -748,7 +757,7 @@ Bug fixes:
 - PR#6805: Duplicated expression in case of hole in a non-failing switch.
   (Luc Maranget)
 
-- PR#6808: the parsing of OCAMLRUNPARAM is too lax
+* PR#6808: the parsing of OCAMLRUNPARAM is too lax
   (Damien Doligez)
 
 - PR#6874: Inefficient code generated for module function arguments
@@ -882,9 +891,15 @@ Bug fixes:
 - PR#7160: Type synonym definitions can weaken gadt constructor types
   (Jacques Garrigue, report by Mikhail Mandrykin)
 
+- PR#7181: Misleading error message with GADTs and polymorphic variants
+  (Jacques Garrigue, report by Pierre Chambart)
+
 - PR#7182: Assertion failure with recursive modules and externals
   (Jacques Garrigue, report by Jeremy Yallop)
 
+- PR#7196: "let open" is not correctly pretty-printed to the left of a ';'
+  (Gabriel Scherer, report by Christophe Raffalli)
+
 - PR#7214: Assertion failure in Env.add_gadt_instances
   (Jacques Garrigue, report by Stephen Dolan)
 
@@ -1074,6 +1089,11 @@ Features wishes:
   GNU parallel tool to run tests in parallel.
   (Gabriel Scherer)
 
+- GPR#555: ensure that register typing constraints are respected at
+  join points in the control flow graph
+  (Mark Shinwell, debugging & test case by Arseniy Alekseyev and Leo White,
+    code review by Xavier Leroy)
+
 Build system:
 =============
 

VERSION

@@ -1,4 +1,4 @@
-4.04.0+dev1-2016-04-18
+4.04.0+dev2-2016-04-27
 
 # The version string is the first line of this file.
 # It must be in the format described in stdlib/sys.mli

asmcomp/cmm.ml

@@ -32,6 +32,56 @@ let size_component = function
   | Int -> Arch.size_int
   | Float -> Arch.size_float
 
+(** [machtype_component]s are partially ordered as follows:
+
+      Addr     Float
+       ^
+       |
+      Val
+       ^
+       |
+      Int
+
+  In particular, [Addr] must be above [Val], to ensure that if there is
+  a join point between a code path yielding [Addr] and one yielding [Val]
+  then the result is treated as a derived pointer into the heap (i.e. [Addr]).
+  (Such a result may not be live across any call site or a fatal compiler
+  error will result.)
+*)
+
+let lub_component comp1 comp2 =
+  match comp1, comp2 with
+  | Int, Int -> Int
+  | Int, Val -> Val
+  | Int, Addr -> Addr
+  | Val, Int -> Val
+  | Val, Val -> Val
+  | Val, Addr -> Addr
+  | Addr, Int -> Addr
+  | Addr, Addr -> Addr
+  | Addr, Val -> Addr
+  | Float, Float -> Float
+  | (Int | Addr | Val), Float
+  | Float, (Int | Addr | Val) ->
+    (* Float unboxing code must be sure to avoid this case. *)
+    assert false
+
+let ge_component comp1 comp2 =
+  match comp1, comp2 with
+  | Int, Int -> true
+  | Int, Addr -> false
+  | Int, Val -> false
+  | Val, Int -> true
+  | Val, Val -> true
+  | Val, Addr -> false
+  | Addr, Int -> true
+  | Addr, Addr -> true
+  | Addr, Val -> true
+  | Float, Float -> true
+  | (Int | Addr | Val), Float
+  | Float, (Int | Addr | Val) ->
+    assert false
+
 let size_machtype mty =
   let size = ref 0 in
   for i = 0 to Array.length mty - 1 do

asmcomp/cmm.mli

@@ -56,6 +56,20 @@ val typ_int: machtype
 val typ_float: machtype
 
 val size_component: machtype_component -> int
+
+(** Least upper bound of two [machtype_component]s. *)
+val lub_component
+   : machtype_component
+  -> machtype_component
+  -> machtype_component
+
+(** Returns [true] iff the first supplied [machtype_component] is greater than
+    or equal to the second under the relation used by [lub_component]. *)
+val ge_component
+   : machtype_component
+  -> machtype_component
+  -> bool
+
 val size_machtype: machtype -> int
 
 type comparison =

asmcomp/selectgen.ml

@@ -117,14 +117,19 @@ let join opt_r1 seq1 opt_r2 seq2 =
       assert (l1 = Array.length r2);
       let r = Array.make l1 Reg.dummy in
       for i = 0 to l1-1 do
-        if Reg.anonymous r1.(i) then begin
+        if Reg.anonymous r1.(i)
+          && Cmm.ge_component r1.(i).typ r2.(i).typ
+        then begin
           r.(i) <- r1.(i);
           seq2#insert_move r2.(i) r1.(i)
-        end else if Reg.anonymous r2.(i) then begin
+        end else if Reg.anonymous r2.(i)
+          && Cmm.ge_component r2.(i).typ r1.(i).typ
+        then begin
           r.(i) <- r2.(i);
           seq1#insert_move r1.(i) r2.(i)
         end else begin
-          r.(i) <- Reg.create r1.(i).typ;
+          let typ = Cmm.lub_component r1.(i).typ r2.(i).typ in
+          r.(i) <- Reg.create typ;
           seq1#insert_move r1.(i) r.(i);
           seq2#insert_move r2.(i) r.(i)
         end

bytecomp/translmod.ml

@@ -557,13 +557,18 @@ let scan_used_globals lam =
   in
   scan lam; !globals
 
-let wrap_globals body =
+let wrap_globals ~flambda body =
   let globals = scan_used_globals body in
   let add_global id req =
-    if IdentSet.mem id globals then req else IdentSet.add id req in
+    if not flambda && IdentSet.mem id globals then
+      req
+    else
+      IdentSet.add id req
+  in
   let required =
-    Hashtbl.fold (fun path _ -> add_global (Path.head path))
+    Hashtbl.fold
-      used_primitives IdentSet.empty
+      (fun path _ -> add_global (Path.head path)) used_primitives
+      (if flambda then globals else IdentSet.empty)
   in
   let required =
     List.fold_right add_global (Env.get_required_globals ()) required
@@ -571,7 +576,7 @@ let wrap_globals body =
   Env.reset_required_globals ();
   Hashtbl.clear used_primitives;
   IdentSet.fold
-    (fun id expr -> Lsequence(Lprim(Pgetglobal id, []), expr))
+    (fun id expr -> Lsequence(Lprim(Popaque, [Lprim(Pgetglobal id, [])]), expr))
     required body
   (* Location.prerr_warning loc
         (Warnings.Nonrequired_global (Ident.name (Path.head path),
@@ -589,7 +594,7 @@ let transl_implementation_flambda module_name (str, cc) =
     Translobj.transl_label_init
       (fun () -> transl_struct [] cc (global_path module_id) str)
   in
-  (module_id, size), wrap_globals body
+  (module_id, size), wrap_globals ~flambda:true body
 
 let transl_implementation module_name (str, cc) =
   let (module_id, _size), module_initializer =
@@ -944,7 +949,7 @@ let transl_store_implementation module_name (str, restr) =
   let (i, r) = transl_store_gen module_name (str, restr) false in
   transl_store_subst := s;
   { Lambda.main_module_block_size = i;
-    code = wrap_globals r; }
+    code = wrap_globals ~flambda:false r; }
 
 (* Compile a toplevel phrase *)
 

byterun/caml/minor_gc.h

@@ -38,7 +38,7 @@ extern int caml_in_minor_collection;
 }
 
 struct caml_ref_table CAML_TABLE_STRUCT(value *);
-CAMLextern struct caml_ref_table caml_ref_table, caml_finalize_table;
+CAMLextern struct caml_ref_table caml_ref_table;
 
 struct caml_ephe_ref_elt {
   value ephe;      /* an ephemeron in major heap */
@@ -48,6 +48,15 @@ struct caml_ephe_ref_elt {
 struct caml_ephe_ref_table CAML_TABLE_STRUCT(struct caml_ephe_ref_elt);
 CAMLextern struct caml_ephe_ref_table caml_ephe_ref_table;
 
+struct caml_custom_elt {
+  value block;     /* The finalized block in the minor heap. */
+  mlsize_t mem;    /* The parameters for adjusting GC speed. */
+  mlsize_t max;
+};
+
+struct caml_custom_table CAML_TABLE_STRUCT(struct caml_custom_elt);
+CAMLextern struct caml_custom_table caml_custom_table;
+
 extern void caml_set_minor_heap_size (asize_t); /* size in bytes */
 extern void caml_empty_minor_heap (void);
 CAMLextern void caml_gc_dispatch (void);
@@ -57,6 +66,9 @@ extern void caml_alloc_table (struct caml_ref_table *, asize_t, asize_t);
 extern void caml_realloc_ephe_ref_table (struct caml_ephe_ref_table *);
 extern void caml_alloc_ephe_table (struct caml_ephe_ref_table *,
                                    asize_t, asize_t);
+extern void caml_realloc_custom_table (struct caml_custom_table *);
+extern void caml_alloc_custom_table (struct caml_custom_table *,
+                                     asize_t, asize_t);
 extern void caml_oldify_one (value, value *);
 extern void caml_oldify_mopup (void);
 
@@ -90,4 +102,18 @@ static inline void add_to_ephe_ref_table (struct caml_ephe_ref_table *tbl,
   Assert(ephe_ref->offset < Wosize_val(ephe_ref->ephe));
 }
 
+static inline void add_to_custom_table (struct caml_custom_table *tbl, value v,
+                                        mlsize_t mem, mlsize_t max)
+{
+  struct caml_custom_elt *elt;
+  if (tbl->ptr >= tbl->limit){
+    CAMLassert (tbl->ptr == tbl->limit);
+    caml_realloc_custom_table (tbl);
+  }
+  elt = tbl->ptr++;
+  elt->block = v;
+  elt->mem = mem;
+  elt->max = max;
+}
+
 #endif /* CAML_MINOR_GC_H */

byterun/compact.c

@@ -405,6 +405,7 @@ void caml_compact_heap (void)
   CAMLassert (caml_young_ptr == caml_young_alloc_end);
   CAMLassert (caml_ref_table.ptr == caml_ref_table.base);
   CAMLassert (caml_ephe_ref_table.ptr == caml_ephe_ref_table.base);
+  CAMLassert (caml_custom_table.ptr == caml_custom_table.base);
 
   do_compaction ();
   CAML_INSTR_TIME (tmr, "compact/main");

byterun/custom.c

@@ -34,13 +34,9 @@ CAMLexport value caml_alloc_custom(struct custom_operations * ops,
   if (wosize <= Max_young_wosize) {
     result = caml_alloc_small(wosize, Custom_tag);
     Custom_ops_val(result) = ops;
-    if (ops->finalize != NULL) {
+    if (ops->finalize != NULL || mem != 0) {
-      /* Remembered that the block has a finalizer */
+      /* Remember that the block needs processing after minor GC. */
-      if (caml_finalize_table.ptr >= caml_finalize_table.limit){
+      add_to_custom_table (&caml_custom_table, result, mem, max);
-        CAMLassert (caml_finalize_table.ptr == caml_finalize_table.limit);
-        caml_realloc_ref_table (&caml_finalize_table);
-      }
-      *caml_finalize_table.ptr++ = (value *)result;
     }
   } else {
     result = caml_alloc_shr(wosize, Custom_tag);

byterun/gc_ctrl.c

@@ -501,7 +501,6 @@ CAMLprim value caml_gc_major_slice (value v)
 {
   CAML_INSTR_SETUP (tmr, "");
   Assert (Is_long (v));
-  caml_empty_minor_heap ();
   caml_major_collection_slice (Long_val (v));
   CAML_INSTR_TIME (tmr, "explicit/gc_major_slice");
   return Val_long (0);

byterun/intern.c

@@ -531,12 +531,8 @@ static void intern_rec(value *dest)
         Custom_ops_val(v) = ops;
 
         if (ops->finalize != NULL && Is_young(v)) {
-          /* Remembered that the block has a finalizer */
+          /* Remember that the block has a finalizer. */
-          if (caml_finalize_table.ptr >= caml_finalize_table.limit){
+          add_to_custom_table (&caml_custom_table, v, 0, 1);
-            CAMLassert (caml_finalize_table.ptr == caml_finalize_table.limit);
-            caml_realloc_ref_table (&caml_finalize_table);
-          }
-          *caml_finalize_table.ptr++ = (value *)v;
         }
 
         intern_dest += 1 + size;

byterun/major_gc.c

@@ -28,6 +28,7 @@
 #include "caml/misc.h"
 #include "caml/mlvalues.h"
 #include "caml/roots.h"
+#include "caml/signals.h"
 #include "caml/weak.h"
 
 #if defined (NATIVE_CODE) && defined (NO_NAKED_POINTERS)
@@ -568,6 +569,7 @@ static void sweep_slice (intnat work)
         ++ caml_stat_major_collections;
         work = 0;
         caml_gc_phase = Phase_idle;
+        caml_request_minor_gc ();
       }else{
         caml_gc_sweep_hp = chunk;
         limit = chunk + Chunk_size (chunk);
@@ -753,7 +755,7 @@ void caml_major_collection_slice (intnat howmuch)
   }
 
   if (caml_gc_phase == Phase_mark || caml_gc_phase == Phase_clean){
-    computed_work = (intnat) (p * (caml_stat_heap_wsz * 250
+    computed_work = (intnat) (p * ((double) caml_stat_heap_wsz * 250
                                    / (100 + caml_percent_free)
                                    + caml_incremental_roots_count));
   }else{

byterun/minor_gc.c

@@ -63,13 +63,16 @@ CAMLexport value *caml_young_ptr = NULL, *caml_young_limit = NULL;
 CAMLexport value *caml_young_trigger = NULL;
 
 CAMLexport struct caml_ref_table
-  caml_ref_table = { NULL, NULL, NULL, NULL, NULL, 0, 0},
+  caml_ref_table = { NULL, NULL, NULL, NULL, NULL, 0, 0};
-  caml_finalize_table = { NULL, NULL, NULL, NULL, NULL, 0, 0};
-/* table of custom blocks containing finalizers in the minor heap */
 
 CAMLexport struct caml_ephe_ref_table
   caml_ephe_ref_table = { NULL, NULL, NULL, NULL, NULL, 0, 0};
 
+CAMLexport struct caml_custom_table
+  caml_custom_table = { NULL, NULL, NULL, NULL, NULL, 0, 0};
+/* Table of custom blocks in the minor heap that contain finalizers
+   or GC speed parameters. */
+
 int caml_in_minor_collection = 0;
 
 /* [sz] and [rsv] are numbers of entries */
@@ -102,6 +105,13 @@ void caml_alloc_ephe_table (struct caml_ephe_ref_table *tbl, asize_t sz,
                        sizeof (struct caml_ephe_ref_elt));
 }
 
+void caml_alloc_custom_table (struct caml_custom_table *tbl, asize_t sz,
+                              asize_t rsv)
+{
+  alloc_generic_table ((struct generic_table *) tbl, sz, rsv,
+                       sizeof (struct caml_custom_elt));
+}
+
 static void reset_table (struct generic_table *tbl)
 {
   tbl->size = 0;
@@ -154,6 +164,7 @@ void caml_set_minor_heap_size (asize_t bsz)
 
   reset_table ((struct generic_table *) &caml_ref_table);
   reset_table ((struct generic_table *) &caml_ephe_ref_table);
+  reset_table ((struct generic_table *) &caml_custom_table);
 }
 
 static value oldify_todo_list = 0;
@@ -319,6 +330,7 @@ void caml_oldify_mopup (void)
 void caml_empty_minor_heap (void)
 {
   value **r;
+  struct caml_custom_elt *elt;
   uintnat prev_alloc_words;
   struct caml_ephe_ref_elt *re;
 
@@ -354,11 +366,15 @@ void caml_empty_minor_heap (void)
       }
     }
     /* Run custom block finalisation of dead minor values */
-    for (r = caml_finalize_table.base; r < caml_finalize_table.ptr; r++){
+    for (elt = caml_custom_table.base; elt < caml_custom_table.ptr; elt++){
-      int hd = Hd_val ((value)*r);
+      value v = elt->block;
-      if (hd != 0){         /* If not oldified the finalizer must be called */
+      if (Hd_val (v) == 0){
-        void (*final_fun)(value) = Custom_ops_val((value)*r)->finalize;
+        /* Block was copied to the major heap: adjust GC speed numbers. */
-        final_fun((value)*r);
+        caml_adjust_gc_speed(elt->mem, elt->max);
+      }else{
+        /* Block will be freed: call finalization function, if any. */
+        void (*final_fun)(value) = Custom_ops_val(v)->finalize;
+        if (final_fun != NULL) final_fun(v);
       }
     }
     CAML_INSTR_TIME (tmr, "minor/update_weak");
@@ -368,7 +384,7 @@ void caml_empty_minor_heap (void)
     caml_young_ptr = caml_young_alloc_end;
     clear_table ((struct generic_table *) &caml_ref_table);
     clear_table ((struct generic_table *) &caml_ephe_ref_table);
-    clear_table ((struct generic_table *) &caml_finalize_table);
+    clear_table ((struct generic_table *) &caml_custom_table);
     caml_gc_message (0x02, ">", 0);
     caml_in_minor_collection = 0;
     caml_final_empty_young ();
@@ -517,3 +533,13 @@ void caml_realloc_ephe_ref_table (struct caml_ephe_ref_table *tbl)
      "Growing ephe_ref_table to %" ARCH_INTNAT_PRINTF_FORMAT "dk bytes\n",
      "Fatal error: ephe_ref_table overflow\n");
 }
+
+void caml_realloc_custom_table (struct caml_custom_table *tbl)
+{
+  realloc_generic_table
+    ((struct generic_table *) tbl, sizeof (struct caml_custom_elt),
+     "request_minor/realloc_custom_table@",
+     "custom_table threshold crossed\n",
+     "Growing custom_table to %" ARCH_INTNAT_PRINTF_FORMAT "dk bytes\n",
+     "Fatal error: custom_table overflow\n");
+}

man/ocamlrun.m

@@ -211,6 +211,11 @@ The multiplier is
 .BR M ,\ or
 .BR G ,
 for multiplication by 2^10, 2^20, and 2^30 respectively.
+
+If the option letter is not recognized, the whole parameter is ignored;
+if the equal sign or the number is missing, the value is taken as 1;
+if the multiplier is not recognized, it is ignored.
+
 For example, on a 32-bit machine under bash, the command
 .B export OCAMLRUNPARAM='s=256k,v=1'
 tells a subsequent
@@ -220,7 +225,7 @@ a message at the start of each major GC cycle.
 .TP
 .B CAMLRUNPARAM
 If OCAMLRUNPARAM is not found in the environment, then CAMLRUNPARAM
-will be used instead.  If CAMLRUNPARAM is not found, then the default
+will be used instead.  If CAMLRUNPARAM is also not found, then the default
 values will be used.
 .TP
 .B PATH

manual/manual/cmds/runtime.etex

@@ -93,7 +93,8 @@ The following environment variables are also consulted:
 \item["OCAMLRUNPARAM"] Set the runtime system options
   and garbage collection parameters.
   (If "OCAMLRUNPARAM" is not set, "CAMLRUNPARAM" will be used instead.)
-  This variable must be a sequence of parameter specifications.
+  This variable must be a sequence of parameter specifications separated
+  by commas.
   A parameter specification is an option letter followed by an "="
   sign, a decimal number (or an hexadecimal number prefixed by "0x"),
   and an optional multiplier.  The options are documented below;
@@ -150,6 +151,11 @@ The following environment variables are also consulted:
   \end{options}
   The multiplier is "k", "M", or "G", for multiplication by $2^{10}$,
   $2^{20}$, and $2^{30}$ respectively.
+
+  If the option letter is not recognized, the whole parameter is ignored;
+  if the equal sign or the number is missing, the value is taken as 1;
+  if the multiplier is not recognized, it is ignored.
+
   For example, on a 32-bit machine, under "bash" the command
 \begin{verbatim}
         export OCAMLRUNPARAM='b,s=256k,v=0x015'
@@ -161,7 +167,7 @@ The following environment variables are also consulted:
 
 \item["CAMLRUNPARAM"]  If "OCAMLRUNPARAM" is not found in the
   environment, then "CAMLRUNPARAM" will be used instead.  If
-  "CAMLRUNPARAM" is not found, then the default values will be used.
+  "CAMLRUNPARAM" is also not found, then the default values will be used.
 
 \item["PATH"] List of directories searched to find the bytecode
 executable file.

manual/manual/library/libunix.etex

@@ -64,8 +64,8 @@ fully implemented and behave as described previously in this chapter.
 \entree{"getppid"}{not implemented (meaningless under Windows)}
 \entree{"nice"}{not implemented}
 \entree{"truncate", "ftruncate"}{not implemented}
-\entree{"link", "symlink", "readlink"}{not implemented (no links under
+\entree{"link"}{implemented (since 3.02)}
-Windows)}
+\entree{"symlink", "readlink"}{implemented (since 4.03.0)}
 \entree{"access"}{execute permission "X_OK" cannot be tested,
   it just tests for read permission instead}
 \entree{"fchmod"}{not implemented}
@@ -73,18 +73,20 @@ Windows)}
 file system)}
 \entree{"umask"}{not implemented}
 \entree{"mkfifo"}{not implemented}
-\entree{"kill", "pause"}{not implemented (no inter-process signals in Windows)}
+\entree{"kill"}{partially implemented (since 4.00.0): only the "sigkill" signal
+is implemented}
+\entree{"pause"}{not implemented (no inter-process signals in Windows)}
 \entree{"alarm"}{not implemented}
 \entree{"times"}{partially implemented, will not report timings for child
 processes}
 \entree{"getitimer", "setitimer"}{not implemented}
-\entree{"getuid", "getgid"}{always return 1}
+\entree{"getuid", "geteuid", "getgid", "getegid"}{always return 1}
-\entree{"getgid", "getegid", "getgroups"}{not implemented}
+\entree{"getgroups"}{always returns "[|1|]" (since 2.00)}
-\entree{"setuid", "setgid"}{not implemented}
+\entree{"setuid", "setgid", "setgroups"}{not implemented}
 \entree{"getpwnam", "getpwuid"}{always raise "Not_found"}
 \entree{"getgrnam", "getgrgid"}{always raise "Not_found"}
-\entree{type "socket_domain"}{the domains "PF_UNIX" and "PF_INET6"
+\entree{type "socket_domain"}{"PF_INET" is fully supported;
-are not supported; "PF_INET" is fully supported}
+"PF_INET6" is fully supported (since 4.01.0); "PF_UNIX" is not supported }
 \entree{"establish_server"}{not implemented; use threads}
 \entree{terminal functions ("tc*")}{not implemented}
 \end{tableau}

manual/manual/refman/exten.etex

@@ -2156,3 +2156,171 @@ expression, but nothing prevents exception values created with this
 constructor from escaping this scope.  Two executions of the definition
 above result in two incompatible exception constructors (as for any
 exception definition).
+
+
+\section{Documentation comments}
+(Introduced in OCaml 4.03)
+
+Comments which start with "**" are treated specially by the
+compiler. They are automatically converted during parsing into
+attributes (see \ref{s:attributes}) to allow tools to process them as
+documentation.
+
+Such comments can take three forms: {\em floating comments}, {\em item
+comments} and {\em label comments}. Any comment starting with "**" which
+does not match one of these forms will cause the compiler to emit
+warning 50.
+
+Comments which start with "**" are also used by the ocamldoc
+documentation generator (see \ref{c:ocamldoc}). The three comment forms
+recognised by the compiler are a subset of the forms accepted by
+ocamldoc (see \ref{s:ocamldoc-comments}).
+
+\subsection{Floating comments}
+
+Comments surrounded by blank lines that appear within structures,
+signatures, classes or class types are converted into
+@floating-attribute@s. For example:
+
+\begin{verbatim}
+type t = T
+
+(** Now some definitions for [t] *)
+
+let mkT = T
+\end{verbatim}
+
+will be converted to:
+
+\begin{verbatim}
+type t = T
+
+[@@@ocaml.text " Now some definitions for [t] "]
+
+let mkT = T
+\end{verbatim}
+
+\subsection{Item comments}
+
+Comments which appear {\em immediately before} or {\em immediately
+after} a structure item, signature item, class item or class type item
+are converted into @item-attribute@s. Immediately before or immediately
+after means that there must be no blank lines, ";;", or other
+documentation comments between them. For example:
+
+\begin{verbatim}
+type t = T
+(** A description of [t] *)
+
+\end{verbatim}
+
+or
+
+\begin{verbatim}
+
+(** A description of [t] *)
+type t = T
+\end{verbatim}
+
+will be converted to:
+
+\begin{verbatim}
+type t = T
+[@@ocaml.doc " A description of [t] "]
+\end{verbatim}
+
+Note that, if a comment appears immediately next to multiple items,
+as in:
+
+\begin{verbatim}
+type t = T
+(** An ambiguous comment *)
+type s = S
+\end{verbatim}
+
+then it will be attached to both items:
+
+\begin{verbatim}
+type t = T
+[@@ocaml.doc " An ambiguous comment "]
+type s = S
+[@@ocaml.doc " An ambiguous comment "]
+\end{verbatim}
+
+and the compiler will emit warning 50.
+
+\subsection{Label comments}
+
+Comments which appear {\em immediately after} a labelled argument,
+record field, variant constructor, object method or polymorphic variant
+constructor are are converted into @attribute@s. Immediately
+after means that there must be no blank lines or other documentation
+comments between them. For example:
+
+\begin{verbatim}
+type t1 = lbl:int (** Labelled argument *) -> unit
+
+type t2 = {
+  fld: int; (** Record field *)
+  fld2: float;
+}
+
+type t3 =
+  | Cstr of string (** Variant constructor *)
+  | Cstr2 of string
+
+type t4 = < meth: int * int; (** Object method *) >
+
+type t5 = [
+  `PCstr (** Polymorphic variant constructor *)
+]
+\end{verbatim}
+
+will be converted to:
+
+\begin{verbatim}
+type t1 = lbl:(int [@ocaml.doc " Labelled argument "]) -> unit
+
+type t2 = {
+  fld: int [@ocaml.doc " Record field "];
+  fld2: float;
+}
+
+type t3 =
+  | Cstr of string [@ocaml.doc " Variant constructor "]
+  | Cstr2 of string
+
+type t4 = < meth : int * int [@ocaml.doc " Object method "] >
+
+type t5 = [
+  `PCstr [@ocaml.doc " Polymorphic variant constructor "]
+]
+\end{verbatim}
+
+Note that label comments take precedence over item comments, so:
+
+\begin{verbatim}
+type t = T of string
+(** Attaches to T not t *)
+\end{verbatim}
+
+will be converted to:
+
+\begin{verbatim}
+type t =  T of string [@ocaml.doc " Attaches to T not t "]
+\end{verbatim}
+
+whilst:
+
+\begin{verbatim}
+type t = T of string
+(** Attaches to T not t *)
+(** Attaches to t *)
+\end{verbatim}
+
+will be converted to:
+
+\begin{verbatim}
+type t =  T of string [@ocaml.doc " Attaches to T not t "]
+[@@ocaml.doc " Attaches to t "]
+\end{verbatim}

middle_end/inlining_decision.ml

@@ -43,7 +43,7 @@ let inline env r ~lhs_of_application
     ~self_call ~fun_cost ~inlining_threshold =
   let toplevel = E.at_toplevel env in
   let branch_depth = E.branch_depth env in
-  let always_inline, never_inline, env =
+  let unrolling, always_inline, never_inline, env =
     let unrolling =
       E.actively_unrolling env function_decls.set_of_closures_origin
     in
@@ -54,8 +54,8 @@ let inline env r ~lhs_of_application
           E.continue_actively_unrolling
             env function_decls.set_of_closures_origin
         in
-        true, false, env
+        true, true, false, env
-      else false, true, env
+      else false, false, true, env
     | None -> begin
         let inline_annotation =
           (* Merge call site annotation and function annotation.
@@ -65,17 +65,17 @@ let inline env r ~lhs_of_application
           | Default_inline -> function_decl.inline
         in
         match inline_annotation with
-        | Always_inline -> true, false, env
+        | Always_inline -> false, true, false, env
-        | Never_inline -> false, true, env
+        | Never_inline -> false, false, true, env
-        | Default_inline -> false, false, env
+        | Default_inline -> false, false, false, env
         | Unroll count ->
           if count > 0 then
             let env =
               E.start_actively_unrolling
                 env function_decls.set_of_closures_origin (count - 1)
             in
-            true, false, env
+            true, true, false, env
-          else false, true, env
+          else false, false, true, env
       end
   in
   let remaining_inlining_threshold : Inlining_cost.Threshold.t =
@@ -83,16 +83,18 @@ let inline env r ~lhs_of_application
     else Lazy.force fun_cost
   in
   let try_inlining =
-    if only_use_of_function || always_inline then
+    if unrolling then
+      Try_it
+    else if self_call then
+      Don't_try_it S.Not_inlined.Self_call
+    else if not (E.inlining_allowed env closure_id_being_applied) then
+      Don't_try_it S.Not_inlined.Unrolling_depth_exceeded
+    else if only_use_of_function || always_inline then
       Try_it
     else if never_inline then
       Don't_try_it S.Not_inlined.Annotation
     else if !Clflags.classic_inlining then
       Don't_try_it S.Not_inlined.Classic_mode
-    else if self_call then
-      Don't_try_it S.Not_inlined.Self_call
-    else if not (E.inlining_allowed env closure_id_being_applied) then
-      Don't_try_it S.Not_inlined.Unrolling_depth_exceeded
     else if not (E.unrolling_allowed env function_decls.set_of_closures_origin)
          && (Lazy.force recursive) then
       Don't_try_it S.Not_inlined.Unrolling_depth_exceeded

otherlibs/systhreads/st_stubs.c

@@ -152,12 +152,10 @@ static void caml_thread_scan_roots(scanning_action action)
   if (prev_scan_roots_hook != NULL) (*prev_scan_roots_hook)(action);
 }
 
-/* Hooks for enter_blocking_section and leave_blocking_section */
+/* Saving and restoring runtime state in curr_thread */
 
-static void caml_thread_enter_blocking_section(void)
+static inline void caml_thread_save_runtime_state(void)
 {
-  /* Save the stack-related global variables in the thread descriptor
-     of the current thread */
 #ifdef NATIVE_CODE
   curr_thread->bottom_of_stack = caml_bottom_of_stack;
   curr_thread->last_retaddr = caml_last_return_address;
@@ -176,18 +174,10 @@ static void caml_thread_enter_blocking_section(void)
   curr_thread->backtrace_pos = backtrace_pos;
   curr_thread->backtrace_buffer = backtrace_buffer;
   curr_thread->backtrace_last_exn = backtrace_last_exn;
-  /* Tell other threads that the runtime is free */
-  st_masterlock_release(&caml_master_lock);
 }
 
-static void caml_thread_leave_blocking_section(void)
+static inline void caml_thread_restore_runtime_state(void)
 {
-  /* Wait until the runtime is free */
-  st_masterlock_acquire(&caml_master_lock);
-  /* Update curr_thread to point to the thread descriptor corresponding
-     to the thread currently executing */
-  curr_thread = st_tls_get(thread_descriptor_key);
-  /* Restore the stack-related global variables */
 #ifdef NATIVE_CODE
   caml_bottom_of_stack= curr_thread->bottom_of_stack;
   caml_last_return_address = curr_thread->last_retaddr;
@@ -208,6 +198,29 @@ static void caml_thread_leave_blocking_section(void)
   backtrace_last_exn = curr_thread->backtrace_last_exn;
 }
 
+/* Hooks for enter_blocking_section and leave_blocking_section */
+
+
+static void caml_thread_enter_blocking_section(void)
+{
+  /* Save the current runtime state in the thread descriptor
+     of the current thread */
+  caml_thread_save_runtime_state();
+  /* Tell other threads that the runtime is free */
+  st_masterlock_release(&caml_master_lock);
+}
+
+static void caml_thread_leave_blocking_section(void)
+{
+  /* Wait until the runtime is free */
+  st_masterlock_acquire(&caml_master_lock);
+  /* Update curr_thread to point to the thread descriptor corresponding
+     to the thread currently executing */
+  curr_thread = st_tls_get(thread_descriptor_key);
+  /* Restore the runtime state from the curr_thread descriptor */
+  caml_thread_restore_runtime_state();
+}
+
 static int caml_thread_try_leave_blocking_section(void)
 {
   /* Disable immediate processing of signals (PR#3659).
@@ -293,7 +306,6 @@ static uintnat caml_thread_stack_usage(void)
 static caml_thread_t caml_thread_new_info(void)
 {
   caml_thread_t th;
-
   th = (caml_thread_t) malloc(sizeof(struct caml_thread_struct));
   if (th == NULL) return NULL;
   th->descr = Val_unit;         /* filled later */
@@ -459,11 +471,11 @@ CAMLprim value caml_thread_cleanup(value unit)   /* ML */
 
 static void caml_thread_stop(void)
 {
-#ifndef NATIVE_CODE
+  /* PR#5188, PR#7220: some of the global runtime state may have
-  /* PR#5188: update curr_thread->stack_low because the stack may have
+     changed as the thread was running, so we save it in the
-     been reallocated since the last time we entered a blocking section */
+     curr_thread data to make sure that the cleanup logic
-  curr_thread->stack_low = stack_low;
+     below uses accurate information. */
-#endif
+  caml_thread_save_runtime_state();
   /* Signal that the thread has terminated */
   caml_threadstatus_terminate(Terminated(curr_thread->descr));
   /* Remove th from the doubly-linked list of threads and free its info block */

otherlibs/unix/unix.ml

@@ -862,12 +862,14 @@ let rec waitpid_non_intr pid =
   try waitpid [] pid
   with Unix_error (EINTR, _, _) -> waitpid_non_intr pid
 
+external sys_exit : int -> 'a = "caml_sys_exit"
+
 let system cmd =
   match fork() with
      0 -> begin try
             execv "/bin/sh" [| "/bin/sh"; "-c"; cmd |]
           with _ ->
-            exit 127
+            sys_exit 127
           end
   | id -> snd(waitpid_non_intr id)
 
@@ -902,7 +904,7 @@ let create_process cmd args new_stdin new_stdout new_stderr =
         perform_redirections new_stdin new_stdout new_stderr;
         execvp cmd args
       with _ ->
-        exit 127
+        sys_exit 127
       end
   | id -> id
 
@@ -913,7 +915,7 @@ let create_process_env cmd args env new_stdin new_stdout new_stderr =
         perform_redirections new_stdin new_stdout new_stderr;
         execvpe cmd args env
       with _ ->
-        exit 127
+        sys_exit 127
       end
   | id -> id
 
@@ -928,11 +930,12 @@ let popen_processes = (Hashtbl.create 7 : (popen_process, int) Hashtbl.t)
 let open_proc cmd proc input output toclose =
   let cloexec = List.for_all try_set_close_on_exec toclose in
   match fork() with
-     0 -> if input <> stdin then begin dup2 input stdin; close input end;
+     0 -> begin try
-          if output <> stdout then begin dup2 output stdout; close output end;
+            if input <> stdin then begin dup2 input stdin; close input end;
-          if not cloexec then List.iter close toclose;
+            if output <> stdout then begin dup2 output stdout; close output end;
-          begin try execv "/bin/sh" [| "/bin/sh"; "-c"; cmd |]
+            if not cloexec then List.iter close toclose;
-          with _ -> exit 127
+            execv "/bin/sh" [| "/bin/sh"; "-c"; cmd |]
+          with _ -> sys_exit 127
           end
   | id -> Hashtbl.add popen_processes proc id
 
@@ -984,12 +987,13 @@ let open_process cmd =
 let open_proc_full cmd env proc input output error toclose =
   let cloexec = List.for_all try_set_close_on_exec toclose in
   match fork() with
-     0 -> dup2 input stdin; close input;
+     0 -> begin try
-          dup2 output stdout; close output;
+            dup2 input stdin; close input;
-          dup2 error stderr; close error;
+            dup2 output stdout; close output;
-          if not cloexec then List.iter close toclose;
+            dup2 error stderr; close error;
-          begin try execve "/bin/sh" [| "/bin/sh"; "-c"; cmd |] env
+            if not cloexec then List.iter close toclose;
-          with _ -> exit 127
+            execve "/bin/sh" [| "/bin/sh"; "-c"; cmd |] env
+          with _ -> sys_exit 127
           end
   | id -> Hashtbl.add popen_processes proc id
 
@@ -1077,7 +1081,8 @@ let establish_server server_fun sockaddr =
     (* The "double fork" trick, the process which calls server_fun will not
        leave a zombie process *)
     match fork() with
-       0 -> if fork() <> 0 then exit 0; (* The son exits, the grandson works *)
+       0 -> if fork() <> 0 then sys_exit 0;
+                                (* The son exits, the grandson works *)
             close sock;
             ignore(try_set_close_on_exec s);
             let inchan = in_channel_of_descr s in

parsing/ast_invariants.ml

@@ -55,7 +55,13 @@ let iterator =
     | _ -> ()
   in
   let pat self pat =
-    super.pat self pat;
+    begin match pat.ppat_desc with
+    | Ppat_construct (_, Some ({ppat_desc = Ppat_tuple _} as p))
+      when Builtin_attributes.explicit_arity pat.ppat_attributes ->
+        super.pat self p (* allow unary tuple, see GPR#523. *)
+    | _ ->
+        super.pat self pat
+    end;
     let loc = pat.ppat_loc in
     match pat.ppat_desc with
     | Ppat_tuple ([] | [_]) -> invalid_tuple loc
@@ -66,7 +72,13 @@ let iterator =
     | _ -> ()
   in
   let expr self exp =
-    super.expr self exp;
+    begin match exp.pexp_desc with
+    | Pexp_construct (_, Some ({pexp_desc = Pexp_tuple _} as e))
+      when Builtin_attributes.explicit_arity exp.pexp_attributes ->
+        super.expr self e (* allow unary tuple, see GPR#523. *)
+    | _ ->
+        super.expr self exp
+    end;
     let loc = exp.pexp_loc in
     match exp.pexp_desc with
     | Pexp_tuple ([] | [_]) -> invalid_tuple loc

parsing/docstrings.ml

@@ -128,6 +128,7 @@ let add_info_attrs info attrs =
 type text = docstring list
 
 let empty_text = []
+let empty_text_lazy = lazy []
 
 let text_loc = {txt = "ocaml.text"; loc = Location.none}
 

parsing/docstrings.mli

@@ -117,6 +117,7 @@ val rhs_info : int -> info
 type text = docstring list
 
 val empty_text : text
+val empty_text_lazy : text Lazy.t
 
 val text_attr : docstring -> Parsetree.attribute
 

parsing/parser.mly

@@ -365,12 +365,13 @@ type let_bindings =
     lbs_extension: string Asttypes.loc option;
     lbs_loc: Location.t }
 
-let mklb (p, e) attrs =
+let mklb first (p, e) attrs =
   { lb_pattern = p;
     lb_expression = e;
     lb_attributes = attrs;
     lb_docs = symbol_docs_lazy ();
-    lb_text = symbol_text_lazy ();
+    lb_text = if first then empty_text_lazy
+              else symbol_text_lazy ();
     lb_loc = symbol_rloc (); }
 
 let mklbs ext rf lb =
@@ -1488,7 +1489,7 @@ simple_expr:
       { mkexp_attrs (Pexp_construct (mkloc (Lident "()") (symbol_rloc ()),
                                None)) $2 }
   | BEGIN ext_attributes seq_expr error
-      { unclosed "begin" 1 "end" 3 }
+      { unclosed "begin" 1 "end" 4 }
   | LPAREN seq_expr type_constraint RPAREN
       { mkexp_constraint $2 $3 }
   | simple_expr DOT label_longident
@@ -1640,11 +1641,11 @@ let_bindings:
 let_binding:
     LET ext_attributes rec_flag let_binding_body post_item_attributes
       { let (ext, attr) = $2 in
-        mklbs ext $3 (mklb $4 (attr@$5)) }
+        mklbs ext $3 (mklb true $4 (attr@$5)) }
 ;
 and_let_binding:
     AND attributes let_binding_body post_item_attributes
-      { mklb $3 ($2@$4) }
+      { mklb false $3 ($2@$4) }
 ;
 fun_binding:
     strict_binding

parsing/pprintast.ml

@@ -476,7 +476,8 @@ class printer  ()= object(self:'self)
         self#paren true self#reset#expression f x
     | Pexp_ifthenelse _ | Pexp_sequence _ when ifthenelse ->
         self#paren true self#reset#expression f x
-    | Pexp_let _ | Pexp_letmodule _ | Pexp_letexception _ when semi ->
+    | Pexp_let _ | Pexp_letmodule _ | Pexp_open _ | Pexp_letexception _
+      when semi ->
         self#paren true self#reset#expression f x
     | Pexp_fun (l, e0, p, e) ->
         pp f "@[<2>fun@;%a@;->@;%a@]"

stdlib/Makefile.shared

@@ -20,7 +20,8 @@ TARGET_BINDIR ?= $(BINDIR)
 
 COMPILER=../ocamlc
 CAMLC=$(CAMLRUN) $(COMPILER)
-COMPFLAGS=-strict-sequence -absname -w +a-4-9-41-42-44-45-48 -g -warn-error A -bin-annot -nostdlib \
+COMPFLAGS=-strict-sequence -absname -w +a-4-9-41-42-44-45-48 \
+          -g -warn-error A -bin-annot -nostdlib \
           -safe-string -strict-formats
 ifeq "$(FLAMBDA)" "true"
 OPTCOMPFLAGS=-O3

stdlib/arg.ml

@@ -46,7 +46,7 @@ type error =
   | Missing of string
   | Message of string
 
-exception Stop of error;; (* used internally *)
+exception Stop of error (* used internally *)
 
 open Printf
 
@@ -55,19 +55,19 @@ let rec assoc3 x l =
   | [] -> raise Not_found
   | (y1, y2, _) :: _ when y1 = x -> y2
   | _ :: t -> assoc3 x t
-;;
+
 
 let split s =
   let i = String.index s '=' in
   let len = String.length s in
   String.sub s 0 i, String.sub s (i+1) (len-(i+1))
-;;
+
 
 let make_symlist prefix sep suffix l =
   match l with
   | [] -> "<none>"
   | h::t -> (List.fold_left (fun x y -> x ^ sep ^ y) (prefix ^ h) t) ^ suffix
-;;
+
 
 let print_spec buf (key, spec, doc) =
   if String.length doc > 0 then
@@ -76,9 +76,9 @@ let print_spec buf (key, spec, doc) =
         bprintf buf "  %s %s%s\n" key (make_symlist "{" "|" "}" l) doc
     | _ ->
         bprintf buf "  %s %s\n" key doc
-;;
 
-let help_action () = raise (Stop (Unknown "-help"));;
+
+let help_action () = raise (Stop (Unknown "-help"))
 
 let add_help speclist =
   let add1 =
@@ -91,24 +91,24 @@ let add_help speclist =
             ["--help", Unit help_action, " Display this list of options"]
   in
   speclist @ (add1 @ add2)
-;;
+
 
 let usage_b buf speclist errmsg =
   bprintf buf "%s\n" errmsg;
-  List.iter (print_spec buf) (add_help speclist);
+  List.iter (print_spec buf) (add_help speclist)
-;;
+
 
 let usage_string speclist errmsg =
   let b = Buffer.create 200 in
   usage_b b speclist errmsg;
-  Buffer.contents b;
+  Buffer.contents b
-;;
+
 
 let usage speclist errmsg =
-  eprintf "%s" (usage_string speclist errmsg);
+  eprintf "%s" (usage_string speclist errmsg)
-;;
 
-let current = ref 0;;
+
+let current = ref 0
 
 let bool_of_string_opt x =
   try Some (bool_of_string x)
@@ -247,28 +247,28 @@ let parse_argv_dynamic ?(current=current) argv speclist anonfun errmsg =
       (try anonfun s with Bad m -> stop (Message m));
       incr current;
     end;
-  done;
+  done
-;;
+
 
 let parse_argv ?(current=current) argv speclist anonfun errmsg =
-  parse_argv_dynamic ~current:current argv (ref speclist) anonfun errmsg;
+  parse_argv_dynamic ~current:current argv (ref speclist) anonfun errmsg
-;;
+
 
 let parse l f msg =
   try
-    parse_argv Sys.argv l f msg;
+    parse_argv Sys.argv l f msg
   with
-  | Bad msg -> eprintf "%s" msg; exit 2;
+  | Bad msg -> eprintf "%s" msg; exit 2
-  | Help msg -> printf "%s" msg; exit 0;
+  | Help msg -> printf "%s" msg; exit 0
-;;
+
 
 let parse_dynamic l f msg =
   try
-    parse_argv_dynamic Sys.argv l f msg;
+    parse_argv_dynamic Sys.argv l f msg
   with
-  | Bad msg -> eprintf "%s" msg; exit 2;
+  | Bad msg -> eprintf "%s" msg; exit 2
-  | Help msg -> printf "%s" msg; exit 0;
+  | Help msg -> printf "%s" msg; exit 0
-;;
+
 
 let second_word s =
   let len = String.length s in
@@ -279,13 +279,13 @@ let second_word s =
   in
   try loop (String.index s ' ')
   with Not_found -> len
-;;
+
 
 let max_arg_len cur (kwd, spec, doc) =
   match spec with
   | Symbol _ -> max cur (String.length kwd)
   | _ -> max cur (String.length kwd + second_word doc)
-;;
+
 
 let add_padding len ksd =
   match ksd with
@@ -308,11 +308,10 @@ let add_padding len ksd =
         let prefix = String.sub msg 0 cutcol in
         let suffix = String.sub msg cutcol (String.length msg - cutcol) in
         (kwd, spec, prefix ^ spaces ^ suffix)
-;;
+
 
 let align ?(limit=max_int) speclist =
   let completed = add_help speclist in
   let len = List.fold_left max_arg_len 0 completed in
   let len = min len limit in
   List.map (add_padding len) completed
-;;

stdlib/array.ml

@@ -132,7 +132,6 @@ let to_list a =
 let rec list_length accu = function
   | [] -> accu
   | _::t -> list_length (succ accu) t
-;;
 
 let of_list = function
     [] -> [||]
@@ -189,7 +188,7 @@ let memq x a =
     else loop (succ i) in
   loop 0
 
-exception Bottom of int;;
+exception Bottom of int
 let sort cmp a =
   let maxson l i =
     let i31 = i+i+i+1 in
@@ -236,10 +235,10 @@ let sort cmp a =
     set a i (get a 0);
     trickleup (bubble i 0) e;
   done;
-  if l > 1 then (let e = (get a 1) in set a 1 (get a 0); set a 0 e);
+  if l > 1 then (let e = (get a 1) in set a 1 (get a 0); set a 0 e)
-;;
 
-let cutoff = 5;;
+
+let cutoff = 5
 let stable_sort cmp a =
   let merge src1ofs src1len src2 src2ofs src2len dst dstofs =
     let src1r = src1ofs + src1len and src2r = src2ofs + src2len in
@@ -289,7 +288,7 @@ let stable_sort cmp a =
     sortto l1 t 0 l2;
     sortto 0 a l2 l1;
     merge l2 l1 t 0 l2 a 0;
-  end;
+  end
-;;
 
-let fast_sort = stable_sort;;
+
+let fast_sort = stable_sort

stdlib/buffer.ml

@@ -34,7 +34,7 @@ let sub b ofs len =
   if ofs < 0 || len < 0 || ofs > b.position - len
   then invalid_arg "Buffer.sub"
   else Bytes.sub_string b.buffer ofs len
-;;
+
 
 let blit src srcoff dst dstoff len =
   if len < 0 || srcoff < 0 || srcoff > src.position - len
@@ -42,13 +42,13 @@ let blit src srcoff dst dstoff len =
   then invalid_arg "Buffer.blit"
   else
     Bytes.unsafe_blit src.buffer srcoff dst dstoff len
-;;
+
 
 let nth b ofs =
   if ofs < 0 || ofs >= b.position then
    invalid_arg "Buffer.nth"
   else Bytes.unsafe_get b.buffer ofs
-;;
+
 
 let length b = b.position
 
@@ -124,7 +124,7 @@ let output_buffer oc b =
 let closing = function
   | '(' -> ')'
   | '{' -> '}'
-  | _ -> assert false;;
+  | _ -> assert false
 
 (* opening and closing: open and close characters, typically ( and )
    k: balance of opening and closing chars
@@ -137,7 +137,7 @@ let advance_to_closing opening closing k s start =
     if s.[i] = closing then
       if k = 0 then i else advance (k - 1) (i + 1) lim
     else advance k (i + 1) lim in
-  advance k start (String.length s);;
+  advance k start (String.length s)
 
 let advance_to_non_alpha s start =
   let rec advance i lim =
@@ -145,7 +145,7 @@ let advance_to_non_alpha s start =
     match s.[i] with
     | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' -> advance (i + 1) lim
     | _ -> i in
-  advance start (String.length s);;
+  advance start (String.length s)
 
 (* We are just at the beginning of an ident in s, starting at start. *)
 let find_ident s start lim =
@@ -159,7 +159,7 @@ let find_ident s start lim =
   (* Regular ident *)
   | _ ->
      let stop = advance_to_non_alpha s (start + 1) in
-     String.sub s start (stop - start), stop;;
+     String.sub s start (stop - start), stop
 
 (* Substitute $ident, $(ident), or ${ident} in s,
     according to the function mapping f. *)
@@ -187,4 +187,4 @@ let add_substitute b f s =
          subst current (i + 1)
     end else
     if previous = '\\' then add_char b previous in
-  subst ' ' 0;;
+  subst ' ' 0

stdlib/bytes.ml

@@ -44,7 +44,7 @@ let init n f =
   done;
   s
 
-let empty = create 0;;
+let empty = create 0
 
 let copy s =
   let len = length s in
@@ -122,7 +122,7 @@ let cat s1 s2 =
   unsafe_blit s1 0 r 0 l1;
   unsafe_blit s2 0 r l1 l2;
   r
-;;
+
 
 external char_code: char -> int = "%identity"
 external char_chr: int -> char = "%identity"
@@ -217,27 +217,27 @@ let uncapitalize_ascii s = apply1 Char.lowercase_ascii s
 
 let rec index_rec s lim i c =
   if i >= lim then raise Not_found else
-  if unsafe_get s i = c then i else index_rec s lim (i + 1) c;;
+  if unsafe_get s i = c then i else index_rec s lim (i + 1) c
 
-let index s c = index_rec s (length s) 0 c;;
+let index s c = index_rec s (length s) 0 c
 
 let index_from s i c =
   let l = length s in
   if i < 0 || i > l then invalid_arg "String.index_from / Bytes.index_from" else
-  index_rec s l i c;;
+  index_rec s l i c
 
 let rec rindex_rec s i c =
   if i < 0 then raise Not_found else
-  if unsafe_get s i = c then i else rindex_rec s (i - 1) c;;
+  if unsafe_get s i = c then i else rindex_rec s (i - 1) c
 
-let rindex s c = rindex_rec s (length s - 1) c;;
+let rindex s c = rindex_rec s (length s - 1) c
 
 let rindex_from s i c =
   if i < -1 || i >= length s then
     invalid_arg "String.rindex_from / Bytes.rindex_from"
   else
     rindex_rec s i c
-;;
+
 
 let contains_from s i c =
   let l = length s in
@@ -245,16 +245,16 @@ let contains_from s i c =
     invalid_arg "String.contains_from / Bytes.contains_from"
   else
     try ignore (index_rec s l i c); true with Not_found -> false
-;;
 
-let contains s c = contains_from s 0 c;;
+
+let contains s c = contains_from s 0 c
 
 let rcontains_from s i c =
   if i < 0 || i >= length s then
     invalid_arg "String.rcontains_from / Bytes.rcontains_from"
   else
     try ignore (rindex_rec s i c); true with Not_found -> false
-;;
+
 
 type t = bytes
 

stdlib/camlinternalFormatBasics.ml

@@ -107,11 +107,11 @@ position in the format tail (('u, .., 'f) fmt). This means that the
 type of the expected format parameter depends of where the %(...%)
 are in the format string:
 
-  # Printf.printf "%(%)";;
+  # Printf.printf "%(%)"
   - : (unit, out_channel, unit, '_a, '_a, unit)
       CamlinternalFormatBasics.format6 -> unit
   = <fun>
-  # Printf.printf "%(%)%d";;
+  # Printf.printf "%(%)%d"
   - : (int -> unit, out_channel, unit, '_a, '_a, int -> unit)
       CamlinternalFormatBasics.format6 -> int -> unit
   = <fun>

stdlib/camlinternalLazy.ml

@@ -15,9 +15,9 @@
 
 (* Internals of forcing lazy values. *)
 
-exception Undefined;;
+exception Undefined
 
-let raise_undefined = Obj.repr (fun () -> raise Undefined);;
+let raise_undefined = Obj.repr (fun () -> raise Undefined)
 
 (* Assume [blk] is a block with tag lazy *)
 let force_lazy_block (blk : 'arg lazy_t) =
@@ -32,7 +32,7 @@ let force_lazy_block (blk : 'arg lazy_t) =
   with e ->
     Obj.set_field (Obj.repr blk) 0 (Obj.repr (fun () -> raise e));
     raise e
-;;
+
 
 (* Assume [blk] is a block with tag lazy *)
 let force_val_lazy_block (blk : 'arg lazy_t) =
@@ -43,7 +43,7 @@ let force_val_lazy_block (blk : 'arg lazy_t) =
   Obj.set_field (Obj.repr blk) 0 (Obj.repr result);
   Obj.set_tag (Obj.repr blk) (Obj.forward_tag);
   result
-;;
+
 
 (* [force] is not used, since [Lazy.force] is declared as a primitive
    whose code inlines the tag tests of its argument.  This function is
@@ -55,7 +55,7 @@ let force (lzv : 'arg lazy_t) =
   if t = Obj.forward_tag then (Obj.obj (Obj.field x 0) : 'arg) else
   if t <> Obj.lazy_tag then (Obj.obj x : 'arg)
   else force_lazy_block lzv
-;;
+
 
 let force_val (lzv : 'arg lazy_t) =
   let x = Obj.repr lzv in
@@ -63,4 +63,3 @@ let force_val (lzv : 'arg lazy_t) =
   if t = Obj.forward_tag then (Obj.obj (Obj.field x 0) : 'arg) else
   if t <> Obj.lazy_tag then (Obj.obj x : 'arg)
   else force_val_lazy_block lzv
-;;

stdlib/camlinternalLazy.mli

@@ -17,11 +17,11 @@
     All functions in this module are for system use only, not for the
     casual user. *)
 
-exception Undefined;;
+exception Undefined
 
-val force_lazy_block : 'a lazy_t -> 'a ;;
+val force_lazy_block : 'a lazy_t -> 'a
 
-val force_val_lazy_block : 'a lazy_t -> 'a ;;
+val force_val_lazy_block : 'a lazy_t -> 'a
 
-val force : 'a lazy_t -> 'a ;;
+val force : 'a lazy_t -> 'a
-val force_val : 'a lazy_t -> 'a ;;
+val force_val : 'a lazy_t -> 'a

stdlib/filename.ml

@@ -74,7 +74,7 @@ module Unix = struct
   let parent_dir_name = ".."
   let dir_sep = "/"
   let is_dir_sep s i = s.[i] = '/'
-  let is_relative n = String.length n < 1 || n.[0] <> '/';;
+  let is_relative n = String.length n < 1 || n.[0] <> '/'
   let is_implicit n =
     is_relative n
     && (String.length n < 2 || String.sub n 0 2 <> "./")
@@ -210,12 +210,12 @@ let chop_extension name =
 external open_desc: string -> open_flag list -> int -> int = "caml_sys_open"
 external close_desc: int -> unit = "caml_sys_close"
 
-let prng = lazy(Random.State.make_self_init ());;
+let prng = lazy(Random.State.make_self_init ())
 
 let temp_file_name temp_dir prefix suffix =
   let rnd = (Random.State.bits (Lazy.force prng)) land 0xFFFFFF in
   concat temp_dir (Printf.sprintf "%s%06x%s" prefix rnd suffix)
-;;
+
 
 let current_temp_dir_name = ref temp_dir_name
 

stdlib/format.ml

@@ -22,12 +22,12 @@
 
 (* A devoted type for sizes to avoid confusion
    between sizes and mere integers. *)
-type size;;
+type size
 
 external size_of_int : int -> size = "%identity"
-;;
+
 external int_of_size : size -> int = "%identity"
-;;
+
 
 (* The pretty-printing boxes definition:
    a pretty-printing box is either
@@ -45,7 +45,7 @@ external int_of_size : size -> int = "%identity"
 *)
 type box_type = CamlinternalFormatBasics.block_type =
   | Pp_hbox | Pp_vbox | Pp_hvbox | Pp_hovbox | Pp_box | Pp_fits
-;;
+
 
 (* The pretty-printing tokens definition:
    are either text to print or pretty printing
@@ -68,7 +68,7 @@ type pp_token =
 and tag = string
 
 and tbox = Pp_tbox of int list ref  (* Tabulation box *)
-;;
+
 
 (* The pretty-printer queue definition:
    pretty-printing material is not written in the output as soon as emitted;
@@ -89,13 +89,13 @@ and 'a queue_cell = {
   mutable head : 'a;
   mutable tail : 'a queue_elem;
 }
-;;
+
 
 type 'a queue = {
   mutable insert : 'a queue_elem;
   mutable body : 'a queue_elem;
 }
-;;
+
 
 (* The pretty-printer queue: queue element definition.
    The pretty-printer queue contains formatting elements to be printed.
@@ -109,20 +109,20 @@ type pp_queue_elem = {
   token : pp_token;
   length : int;
 }
-;;
+
 
 (* The pretty-printer queue definition. *)
-type pp_queue = pp_queue_elem queue;;
+type pp_queue = pp_queue_elem queue
 
 (* The pretty-printer scanning stack. *)
 
 (* The pretty-printer scanning stack: scanning element definition.
    Each element is (left_total, queue element) where left_total
    is the value of pp_left_total when the element has been enqueued. *)
-type pp_scan_elem = Scan_elem of int * pp_queue_elem;;
+type pp_scan_elem = Scan_elem of int * pp_queue_elem
 
 (* The pretty-printer scanning stack definition. *)
-type pp_scan_stack = pp_scan_elem list;;
+type pp_scan_stack = pp_scan_elem list
 
 (* The pretty-printer formatting stack:
    the formatting stack contains the description of all the currently active
@@ -131,13 +131,13 @@ type pp_scan_stack = pp_scan_elem list;;
 
 (* The pretty-printer formatting stack: formatting stack element definition.
    Each stack element describes a pretty-printing box. *)
-type pp_format_elem = Format_elem of box_type * int;;
+type pp_format_elem = Format_elem of box_type * int
 
 (* The pretty-printer formatting stack definition. *)
-type pp_format_stack = pp_format_elem list;;
+type pp_format_stack = pp_format_elem list
 
 (* The pretty-printer semantics tag stack definition. *)
-type pp_tag_stack = tag list;;
+type pp_tag_stack = tag list
 
 (* The formatter definition.
    Each formatter value is a pretty-printer instance with all its
@@ -192,7 +192,7 @@ type formatter = {
   (* The pretty-printer queue. *)
   mutable pp_queue : pp_queue;
 }
-;;
+
 
 (* The formatter specific tag handling functions. *)
 type formatter_tag_functions = {
@@ -201,7 +201,7 @@ type formatter_tag_functions = {
   print_open_tag : tag -> unit;
   print_close_tag : tag -> unit;
 }
-;;
+
 
 (* The formatter functions to output material. *)
 type formatter_out_functions = {
@@ -210,7 +210,7 @@ type formatter_out_functions = {
   out_newline : unit -> unit;
   out_spaces : int -> unit;
 }
-;;
+
 
 (*
 
@@ -220,9 +220,9 @@ type formatter_out_functions = {
 
 (* Queues auxiliaries. *)
 
-let make_queue () = { insert = Nil; body = Nil; };;
+let make_queue () = { insert = Nil; body = Nil; }
 
-let clear_queue q = q.insert <- Nil; q.body <- Nil;;
+let clear_queue q = q.insert <- Nil; q.body <- Nil
 
 let add_queue x q =
   let c = Cons { head = x; tail = Nil; } in
@@ -232,14 +232,14 @@ let add_queue x q =
   (* Invariant: when insert is Nil body should be Nil. *)
   | { insert = Nil; body = _; } ->
     q.insert <- c; q.body <- c
-;;
 
-exception Empty_queue;;
+
+exception Empty_queue
 
 let peek_queue = function
   | { body = Cons { head = x; tail = _; }; _ } -> x
   | { body = Nil; insert = _; } -> raise Empty_queue
-;;
+
 
 let take_queue = function
   | { body = Cons { head = x; tail = tl; }; _ } as q ->
@@ -247,18 +247,18 @@ let take_queue = function
     if tl = Nil then q.insert <- Nil; (* Maintain the invariant. *)
     x
   | { body = Nil; insert = _; } -> raise Empty_queue
-;;
+
 
 (* Enter a token in the pretty-printer queue. *)
 let pp_enqueue state ({ length = len; _} as token) =
   state.pp_right_total <- state.pp_right_total + len;
   add_queue token state.pp_queue
-;;
+
 
 let pp_clear_queue state =
   state.pp_left_total <- 1; state.pp_right_total <- 1;
   clear_queue state.pp_queue
-;;
+
 
 (* Pp_infinity: large value for default tokens size.
 
@@ -280,7 +280,7 @@ let pp_clear_queue state =
    + 1 is in practice large enough, there is no need to attempt to set
    pp_infinity to the theoretically maximum limit. It is not worth the
    burden ! *)
-let pp_infinity = 1000000010;;
+let pp_infinity = 1000000010
 
 (* Output functions for the formatter. *)
 let pp_output_string state s = state.pp_out_string s 0 (String.length s)
@@ -297,16 +297,16 @@ let break_new_line state offset width =
   state.pp_current_indent <- real_indent;
   state.pp_space_left <- state.pp_margin - state.pp_current_indent;
   pp_output_spaces state state.pp_current_indent
-;;
+
 
 (* To force a line break inside a box: no offset is added. *)
-let break_line state width = break_new_line state 0 width;;
+let break_line state width = break_new_line state 0 width
 
 (* To format a break that fits on the current line. *)
 let break_same_line state width =
   state.pp_space_left <- state.pp_space_left - width;
   pp_output_spaces state width
-;;
+
 
 (* To indent no more than pp_max_indent, if one tries to open a box
    beyond pp_max_indent, then the box is rejected on the left
@@ -320,7 +320,7 @@ let pp_force_break_line state =
        | Pp_vbox | Pp_hvbox | Pp_hovbox | Pp_box ->
          break_line state width)
   | [] -> pp_output_newline state
-;;
+
 
 (* To skip a token, if the previous line has been broken. *)
 let pp_skip_token state =
@@ -329,7 +329,7 @@ let pp_skip_token state =
   | { elem_size = size; length = len; token = _; } ->
     state.pp_left_total <- state.pp_left_total - len;
     state.pp_space_left <- state.pp_space_left + int_of_size size
-;;
+
 
 (*
 
@@ -455,7 +455,7 @@ let format_pp_token state size = function
        state.pp_mark_stack <- tags
      | [] -> () (* No more tag to close. *)
      end
-;;
+
 
 (* Print if token size is known else printing is delayed.
    Size is known when not negative.
@@ -476,31 +476,31 @@ let rec advance_loop state =
       state.pp_left_total <- len + state.pp_left_total;
       advance_loop state
     end
-;;
+
 
 let advance_left state =
   try advance_loop state with
   | Empty_queue -> ()
-;;
+
 
 (* To enqueue a token : try to advance. *)
-let enqueue_advance state tok = pp_enqueue state tok; advance_left state;;
+let enqueue_advance state tok = pp_enqueue state tok; advance_left state
 
 (* Building pretty-printer queue elements. *)
 let make_queue_elem size tok len =
   { elem_size = size; token = tok; length = len; }
-;;
+
 
 (* To enqueue strings. *)
 let enqueue_string_as state size s =
   let len = int_of_size size in
   enqueue_advance state (make_queue_elem size (Pp_text s) len)
-;;
+
 
 let enqueue_string state s =
   let len = String.length s in
   enqueue_string_as state (size_of_int len) s
-;;
+
 
 (* Routines for scan stack
    determine size of boxes. *)
@@ -509,10 +509,10 @@ let enqueue_string state s =
 let scan_stack_bottom =
   let q_elem = make_queue_elem (size_of_int (-1)) (Pp_text "") 0 in
   [Scan_elem (-1, q_elem)]
-;;
+
 
 (* Clearing the pretty-printer scanning stack. *)
-let clear_scan_stack state = state.pp_scan_stack <- scan_stack_bottom;;
+let clear_scan_stack state = state.pp_scan_stack <- scan_stack_bottom
 
 (* Setting the size of boxes on scan stack:
    if ty = true then size of break is set else size of box is set;
@@ -550,7 +550,7 @@ let set_size state ty =
         () (* scan_push is only used for breaks and boxes. *)
       end
   | [] -> () (* scan_stack is never empty. *)
-;;
+
 
 (* Push a token on pretty-printer scanning stack.
    If b is true set_size is called. *)
@@ -559,7 +559,7 @@ let scan_push state b tok =
   if b then set_size state true;
   state.pp_scan_stack <-
     Scan_elem (state.pp_right_total, tok) :: state.pp_scan_stack
-;;
+
 
 (* To open a new box :
    the user may set the depth bound pp_max_boxes
@@ -575,10 +575,10 @@ let pp_open_box_gen state indent br_ty =
     scan_push state false elem else
   if state.pp_curr_depth = state.pp_max_boxes
   then enqueue_string state state.pp_ellipsis
-;;
+
 
 (* The box which is always opened. *)
-let pp_open_sys_box state = pp_open_box_gen state 0 Pp_hovbox;;
+let pp_open_sys_box state = pp_open_box_gen state 0 Pp_hovbox
 
 (* Close a box, setting sizes of its sub boxes. *)
 let pp_close_box state () =
@@ -592,7 +592,7 @@ let pp_close_box state () =
     end;
     state.pp_curr_depth <- state.pp_curr_depth - 1;
   end
-;;
+
 
 (* Open a tag, pushing it on the tag stack. *)
 let pp_open_tag state tag_name =
@@ -607,7 +607,7 @@ let pp_open_tag state tag_name =
       token = Pp_open_tag tag_name;
       length = 0;
     }
-;;
+
 
 (* Close a tag, popping it from the tag stack. *)
 let pp_close_tag state () =
@@ -625,15 +625,15 @@ let pp_close_tag state () =
       state.pp_tag_stack <- tags
     | _ -> () (* No more tag to close. *)
   end
-;;
 
-let pp_set_print_tags state b = state.pp_print_tags <- b;;
+
-let pp_set_mark_tags state b = state.pp_mark_tags <- b;;
+let pp_set_print_tags state b = state.pp_print_tags <- b
-let pp_get_print_tags state () = state.pp_print_tags;;
+let pp_set_mark_tags state b = state.pp_mark_tags <- b
-let pp_get_mark_tags state () = state.pp_mark_tags;;
+let pp_get_print_tags state () = state.pp_print_tags
+let pp_get_mark_tags state () = state.pp_mark_tags
 let pp_set_tags state b =
   pp_set_print_tags state b; pp_set_mark_tags state b
-;;
+
 
 (* Handling tag handling functions: get/set functions. *)
 let pp_get_formatter_tag_functions state () = {
@@ -642,7 +642,7 @@ let pp_get_formatter_tag_functions state () = {
   print_open_tag = state.pp_print_open_tag;
   print_close_tag = state.pp_print_close_tag;
 }
-;;
+
 
 let pp_set_formatter_tag_functions state {
      mark_open_tag = mot;
@@ -654,7 +654,7 @@ let pp_set_formatter_tag_functions state {
   state.pp_mark_close_tag <- mct;
   state.pp_print_open_tag <- pot;
   state.pp_print_close_tag <- pct
-;;
+
 
 (* Initialize pretty-printer. *)
 let pp_rinit state =
@@ -668,7 +668,7 @@ let pp_rinit state =
   state.pp_curr_depth <- 0;
   state.pp_space_left <- state.pp_margin;
   pp_open_sys_box state
-;;
+
 
 (* Flushing pretty-printer queue. *)
 let pp_flush_queue state b =
@@ -679,7 +679,7 @@ let pp_flush_queue state b =
   advance_left state;
   if b then pp_output_newline state;
   pp_rinit state
-;;
+
 
 (*
 
@@ -691,29 +691,29 @@ let pp_flush_queue state b =
 let pp_print_as_size state size s =
   if state.pp_curr_depth < state.pp_max_boxes
   then enqueue_string_as state size s
-;;
+
 
 let pp_print_as state isize s =
   pp_print_as_size state (size_of_int isize) s
-;;
+
 
 let pp_print_string state s =
   pp_print_as state (String.length s) s
-;;
+
 
 (* To format an integer. *)
-let pp_print_int state i = pp_print_string state (string_of_int i);;
+let pp_print_int state i = pp_print_string state (string_of_int i)
 
 (* To format a float. *)
-let pp_print_float state f = pp_print_string state (string_of_float f);;
+let pp_print_float state f = pp_print_string state (string_of_float f)
 
 (* To format a boolean. *)
-let pp_print_bool state b = pp_print_string state (string_of_bool b);;
+let pp_print_bool state b = pp_print_string state (string_of_bool b)
 
 (* To format a char. *)
 let pp_print_char state c =
   pp_print_as state 1 (String.make 1 c)
-;;
+
 
 (* Opening boxes. *)
 let pp_open_hbox state () = pp_open_box_gen state 0 Pp_hbox
@@ -722,7 +722,7 @@ and pp_open_vbox state indent = pp_open_box_gen state indent Pp_vbox
 and pp_open_hvbox state indent = pp_open_box_gen state indent Pp_hvbox
 and pp_open_hovbox state indent = pp_open_box_gen state indent Pp_hovbox
 and pp_open_box state indent = pp_open_box_gen state indent Pp_box
-;;
+
 
 (* Printing all queued text.
    [print_newline] prints a new line after flushing the queue.
@@ -731,19 +731,19 @@ let pp_print_newline state () =
   pp_flush_queue state true; state.pp_out_flush ()
 and pp_print_flush state () =
   pp_flush_queue state false; state.pp_out_flush ()
-;;
+
 
 (* To get a newline when one does not want to close the current box. *)
 let pp_force_newline state () =
   if state.pp_curr_depth < state.pp_max_boxes then
     enqueue_advance state (make_queue_elem (size_of_int 0) Pp_newline 0)
-;;
+
 
 (* To format something, only in case the line has just been broken. *)
 let pp_print_if_newline state () =
   if state.pp_curr_depth < state.pp_max_boxes then
     enqueue_advance state (make_queue_elem (size_of_int 0) Pp_if_newline 0)
-;;
+
 
 (* Printing break hints:
    A break hint indicates where a box may be broken.
@@ -757,7 +757,7 @@ let pp_print_break state width offset =
         (Pp_break (width, offset))
         width in
     scan_push state true elem
-;;
+
 
 (* Print a space :
    a space is a break hint that prints a single space if the break does not
@@ -766,7 +766,7 @@ let pp_print_break state width offset =
    line. *)
 let pp_print_space state () = pp_print_break state 1 0
 and pp_print_cut state () = pp_print_break state 0 0
-;;
+
 
 (* Tabulation boxes. *)
 let pp_open_tbox state () =
@@ -775,7 +775,7 @@ let pp_open_tbox state () =
     let elem =
       make_queue_elem (size_of_int 0) (Pp_tbegin (Pp_tbox (ref []))) 0 in
     enqueue_advance state elem
-;;
+
 
 (* Close a tabulation box. *)
 let pp_close_tbox state () =
@@ -786,7 +786,7 @@ let pp_close_tbox state () =
      enqueue_advance state elem;
      state.pp_curr_depth <- state.pp_curr_depth - 1
   end
-;;
+
 
 (* Print a tabulation break. *)
 let pp_print_tbreak state width offset =
@@ -797,16 +797,16 @@ let pp_print_tbreak state width offset =
         (Pp_tbreak (width, offset))
         width in
     scan_push state true elem
-;;
 
-let pp_print_tab state () = pp_print_tbreak state 0 0;;
+
+let pp_print_tab state () = pp_print_tbreak state 0 0
 
 let pp_set_tab state () =
   if state.pp_curr_depth < state.pp_max_boxes then
     let elem =
       make_queue_elem (size_of_int 0) Pp_stab 0 in
     enqueue_advance state elem
-;;
+
 
 (*
 
@@ -815,22 +815,22 @@ let pp_set_tab state () =
 *)
 
 (* Set_max_boxes. *)
-let pp_set_max_boxes state n = if n > 1 then state.pp_max_boxes <- n;;
+let pp_set_max_boxes state n = if n > 1 then state.pp_max_boxes <- n
 
 (* To know the current maximum number of boxes allowed. *)
-let pp_get_max_boxes state () = state.pp_max_boxes;;
+let pp_get_max_boxes state () = state.pp_max_boxes
 
-let pp_over_max_boxes state () = state.pp_curr_depth = state.pp_max_boxes;;
+let pp_over_max_boxes state () = state.pp_curr_depth = state.pp_max_boxes
 
 (* Ellipsis. *)
 let pp_set_ellipsis_text state s = state.pp_ellipsis <- s
 and pp_get_ellipsis_text state () = state.pp_ellipsis
-;;
+
 
 (* To set the margin of pretty-printer. *)
 let pp_limit n =
   if n < pp_infinity then n else pred pp_infinity
-;;
+
 
 (* Internal pretty-printer functions. *)
 let pp_set_min_space_left state n =
@@ -839,16 +839,16 @@ let pp_set_min_space_left state n =
     state.pp_min_space_left <- n;
     state.pp_max_indent <- state.pp_margin - state.pp_min_space_left;
     pp_rinit state
-;;
+
 
 (* Initially, we have :
    pp_max_indent = pp_margin - pp_min_space_left, and
    pp_space_left = pp_margin. *)
 let pp_set_max_indent state n =
   pp_set_min_space_left state (state.pp_margin - n)
-;;
 
-let pp_get_max_indent state () = state.pp_max_indent;;
+
+let pp_get_max_indent state () = state.pp_max_indent
 
 let pp_set_margin state n =
   if n >= 1 then
@@ -865,9 +865,9 @@ let pp_set_margin state n =
                 (state.pp_margin / 2)) 1 in
     (* Rebuild invariants. *)
     pp_set_max_indent state new_max_indent
-;;
 
-let pp_get_margin state () = state.pp_margin;;
+
+let pp_get_margin state () = state.pp_margin
 
 (* Setting a formatter basic output functions. *)
 let pp_set_formatter_out_functions state {
@@ -879,8 +879,8 @@ let pp_set_formatter_out_functions state {
   state.pp_out_string <- f;
   state.pp_out_flush <- g;
   state.pp_out_newline <- h;
-  state.pp_out_spaces <- i;
+  state.pp_out_spaces <- i
-;;
+
 
 let pp_get_formatter_out_functions state () = {
   out_string = state.pp_out_string;
@@ -888,24 +888,24 @@ let pp_get_formatter_out_functions state () = {
   out_newline = state.pp_out_newline;
   out_spaces = state.pp_out_spaces;
 }
-;;
+
 
 (* Setting a formatter basic string output and flush functions. *)
 let pp_set_formatter_output_functions state f g =
   state.pp_out_string <- f; state.pp_out_flush <- g
-;;
+
 let pp_get_formatter_output_functions state () =
   (state.pp_out_string, state.pp_out_flush)
-;;
+
 
 let pp_flush_formatter state =
   pp_flush_queue state false
 
 (* The default function to output new lines. *)
-let display_newline state () = state.pp_out_string "\n" 0  1;;
+let display_newline state () = state.pp_out_string "\n" 0  1
 
 (* The default function to output spaces. *)
-let blank_line = String.make 80 ' ';;
+let blank_line = String.make 80 ' '
 let rec display_blanks state n =
   if n > 0 then
   if n <= 80 then state.pp_out_string blank_line 0 n else
@@ -913,7 +913,7 @@ let rec display_blanks state n =
     state.pp_out_string blank_line 0 80;
     display_blanks state (n - 80)
   end
-;;
+
 
 (* Setting a formatter basic output functions as printing to a given
    [Pervasive.out_channel] value. *)
@@ -921,8 +921,8 @@ let pp_set_formatter_out_channel state os =
   state.pp_out_string <- output_substring os;
   state.pp_out_flush <- (fun () -> flush os);
   state.pp_out_newline <- display_newline state;
-  state.pp_out_spaces <- display_blanks state;
+  state.pp_out_spaces <- display_blanks state
-;;
+
 
 (*
 
@@ -930,11 +930,11 @@ let pp_set_formatter_out_channel state os =
 
 *)
 
-let default_pp_mark_open_tag s = "<" ^ s ^ ">";;
+let default_pp_mark_open_tag s = "<" ^ s ^ ">"
-let default_pp_mark_close_tag s = "</" ^ s ^ ">";;
+let default_pp_mark_close_tag s = "</" ^ s ^ ">"
 
-let default_pp_print_open_tag = ignore;;
+let default_pp_print_open_tag = ignore
-let default_pp_print_close_tag = ignore;;
+let default_pp_print_close_tag = ignore
 
 (* Bulding a formatter given its basic output functions.
    Other fields get reasonable default values. *)
@@ -977,7 +977,7 @@ let pp_make_formatter f g h i =
     pp_print_close_tag = default_pp_print_close_tag;
     pp_queue = pp_queue;
   }
-;;
+
 
 (* Make a formatter with default functions to output spaces and new lines. *)
 let make_formatter output flush =
@@ -985,33 +985,33 @@ let make_formatter output flush =
   ppf.pp_out_newline <- display_newline ppf;
   ppf.pp_out_spaces <- display_blanks ppf;
   ppf
-;;
+
 
 (* Make a formatter writing to a given [Pervasive.out_channel] value. *)
 let formatter_of_out_channel oc =
   make_formatter (output_substring oc) (fun () -> flush oc)
-;;
+
 
 (* Make a formatter writing to a given [Buffer.t] value. *)
 let formatter_of_buffer b =
   make_formatter (Buffer.add_substring b) ignore
-;;
+
 
 (* Allocating buffer for pretty-printing purposes.
    Default buffer size is pp_buffer_size or 512.
 *)
-let pp_buffer_size = 512;;
+let pp_buffer_size = 512
-let pp_make_buffer () = Buffer.create pp_buffer_size;;
+let pp_make_buffer () = Buffer.create pp_buffer_size
 
 (* The standard (shared) buffer. *)
-let stdbuf = pp_make_buffer ();;
+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
 and str_formatter = formatter_of_buffer stdbuf
-;;
+
 
 (* [flush_buffer_formatter buf ppf] flushes formatter [ppf],
    then return the contents of buffer [buff] thst is reset.
@@ -1022,10 +1022,10 @@ let flush_buffer_formatter buf ppf =
   let s = Buffer.contents buf in
   Buffer.reset buf;
   s
-;;
+
 
 (* Flush [str_formatter] and get the contents of [stdbuf]. *)
-let flush_str_formatter () = flush_buffer_formatter stdbuf str_formatter;;
+let flush_str_formatter () = flush_buffer_formatter stdbuf str_formatter
 
 (*
 
@@ -1103,7 +1103,7 @@ and get_mark_tags =
   pp_get_mark_tags std_formatter
 and set_tags =
   pp_set_tags std_formatter
-;;
+
 
 (* Convenience functions *)
 
@@ -1253,10 +1253,10 @@ let kfprintf k ppf (Format (fmt, _)) =
 and ikfprintf k ppf (Format (fmt, _)) =
   make_iprintf k ppf fmt
 
-let fprintf ppf = kfprintf ignore ppf;;
+let fprintf ppf = kfprintf ignore ppf
-let ifprintf ppf = ikfprintf ignore ppf;;
+let ifprintf ppf = ikfprintf ignore ppf
-let printf fmt = fprintf std_formatter fmt;;
+let printf fmt = fprintf std_formatter fmt
-let eprintf fmt = fprintf err_formatter fmt;;
+let eprintf fmt = fprintf err_formatter fmt
 
 let ksprintf k (Format (fmt, _)) =
   let b = pp_make_buffer () in
@@ -1265,9 +1265,9 @@ let ksprintf k (Format (fmt, _)) =
     strput_acc ppf acc;
     k (flush_buffer_formatter b ppf) in
   make_printf k () End_of_acc fmt
-;;
 
-let sprintf fmt = ksprintf (fun s -> s) fmt;;
+
+let sprintf fmt = ksprintf (fun s -> s) fmt
 
 let kasprintf k (Format (fmt, _)) =
   let b = pp_make_buffer () in
@@ -1276,13 +1276,13 @@ let kasprintf k (Format (fmt, _)) =
     output_acc ppf acc;
     k (flush_buffer_formatter b ppf) in
   make_printf k ppf End_of_acc fmt
-;;
 
-let asprintf fmt = kasprintf (fun s -> s) fmt;;
+
+let asprintf fmt = kasprintf (fun s -> s) fmt
 
 (* Output everything left in the pretty printer queue at end of execution. *)
-at_exit print_flush
+let () = at_exit print_flush
-;;
+
 
 (*
 
@@ -1295,24 +1295,24 @@ let pp_set_all_formatter_output_functions state
     ~out:f ~flush:g ~newline:h ~spaces:i =
   pp_set_formatter_output_functions state f g;
   state.pp_out_newline <- h;
-  state.pp_out_spaces <- i;
+  state.pp_out_spaces <- i
-;;
+
 
 (* Deprecated : subsumed by pp_get_formatter_out_functions *)
 let pp_get_all_formatter_output_functions state () =
   (state.pp_out_string, state.pp_out_flush,
    state.pp_out_newline, state.pp_out_spaces)
-;;
+
 
 (* Deprecated : subsumed by set_formatter_out_functions *)
 let set_all_formatter_output_functions =
   pp_set_all_formatter_output_functions std_formatter
-;;
+
 
 (* Deprecated : subsumed by get_formatter_out_functions *)
 let get_all_formatter_output_functions =
   pp_get_all_formatter_output_functions std_formatter
-;;
+
 
 (* Deprecated : error prone function, do not use it.
    Define a formatter of your own writing to the buffer,
@@ -1322,7 +1322,7 @@ let get_all_formatter_output_functions =
 let bprintf b (Format (fmt, _) : ('a, formatter, unit) format) =
   let k ppf acc = output_acc ppf acc; pp_flush_queue ppf false in
   make_printf k (formatter_of_buffer b) End_of_acc fmt
-;;
+
 
 (* Deprecated : alias for ksprintf. *)
-let kprintf = ksprintf;;
+let kprintf = ksprintf

stdlib/gc.ml

@@ -30,7 +30,7 @@ type stat = {
   compactions : int;
   top_heap_words : int;
   stack_size : int;
-};;
+}
 
 type control = {
   mutable minor_heap_size : int;
@@ -41,24 +41,24 @@ type control = {
   mutable stack_limit : int;
   mutable allocation_policy : int;
   window_size : int;
-};;
+}
 
-external stat : unit -> stat = "caml_gc_stat";;
+external stat : unit -> stat = "caml_gc_stat"
-external quick_stat : unit -> stat = "caml_gc_quick_stat";;
+external quick_stat : unit -> stat = "caml_gc_quick_stat"
-external counters : unit -> (float * float * float) = "caml_gc_counters";;
+external counters : unit -> (float * float * float) = "caml_gc_counters"
-external get : unit -> control = "caml_gc_get";;
+external get : unit -> control = "caml_gc_get"
-external set : control -> unit = "caml_gc_set";;
+external set : control -> unit = "caml_gc_set"
-external minor : unit -> unit = "caml_gc_minor";;
+external minor : unit -> unit = "caml_gc_minor"
-external major_slice : int -> int = "caml_gc_major_slice";;
+external major_slice : int -> int = "caml_gc_major_slice"
-external major : unit -> unit = "caml_gc_major";;
+external major : unit -> unit = "caml_gc_major"
-external full_major : unit -> unit = "caml_gc_full_major";;
+external full_major : unit -> unit = "caml_gc_full_major"
-external compact : unit -> unit = "caml_gc_compaction";;
+external compact : unit -> unit = "caml_gc_compaction"
 external get_minor_free : unit -> int = "caml_get_minor_free" [@@noalloc]
 external get_bucket : int -> int = "caml_get_major_bucket" [@@noalloc]
 external get_credit : unit -> int = "caml_get_major_credit" [@@noalloc]
 external huge_fallback_count : unit -> int = "caml_gc_huge_fallback_count"
 
-open Printf;;
+open Printf
 
 let print_stat c =
   let st = stat () in
@@ -81,32 +81,32 @@ let print_stat c =
   fprintf c "\n";
   fprintf c "live_blocks: %d\n" st.live_blocks;
   fprintf c "free_blocks: %d\n" st.free_blocks;
-  fprintf c "heap_chunks: %d\n" st.heap_chunks;
+  fprintf c "heap_chunks: %d\n" st.heap_chunks
-;;
+
 
 let allocated_bytes () =
   let (mi, pro, ma) = counters () in
   (mi +. ma -. pro) *. float_of_int (Sys.word_size / 8)
-;;
-
-external finalise : ('a -> unit) -> 'a -> unit = "caml_final_register";;
-external finalise_release : unit -> unit = "caml_final_release";;
 
 
-type alarm = bool ref;;
+external finalise : ('a -> unit) -> 'a -> unit = "caml_final_register"
-type alarm_rec = {active : alarm; f : unit -> unit};;
+external finalise_release : unit -> unit = "caml_final_release"
+
+
+type alarm = bool ref
+type alarm_rec = {active : alarm; f : unit -> unit}
 
 let rec call_alarm arec =
   if !(arec.active) then begin
     finalise call_alarm arec;
     arec.f ();
-  end;
+  end
-;;
+
 
 let create_alarm f =
   let arec = { active = ref true; f = f } in
   finalise call_alarm arec;
   arec.active
-;;
 
-let delete_alarm a = a := false;;
+
+let delete_alarm a = a := false

stdlib/gc.mli

@@ -185,9 +185,8 @@ external major_slice : int -> int = "caml_gc_major_slice"
     Do a minor collection and a slice of major collection. [n] is the
     size of the slice: the GC will do enough work to free (on average)
     [n] words of memory. If [n] = 0, the GC will try to do enough work
-    to ensure that the next slice has no work to do.
+    to ensure that the next automatic slice has no work to do.
-    Return an approximation of the work that the next slice will have
+    This function returns an unspecified integer (currently: 0). *)
-    to do. *)
 
 external major : unit -> unit = "caml_gc_major"
 (** Do a minor collection and finish the current major collection cycle. *)
@@ -258,7 +257,7 @@ val finalise : ('a -> unit) -> 'a -> unit
 
    Instead you should make sure that [v] is not in the closure of
    the finalisation function by writing:
-   - [ let f = fun x -> ... ;; let v = ... in Gc.finalise f v ]
+   - [ let f = fun x -> ...  let v = ... in Gc.finalise f v ]
 
 
    The [f] function can use all features of OCaml, including

stdlib/hashtbl.mli

@@ -227,7 +227,7 @@ val stats : ('a, 'b) t -> statistics
       module IntHashtbl = Hashtbl.Make(IntHash)
 
       let h = IntHashtbl.create 17 in
-      IntHashtbl.add h 12 "hello";;
+      IntHashtbl.add h 12 "hello"
     ]}
 
     This creates a new module [IntHashtbl], with a new type ['a

stdlib/lazy.ml

@@ -45,23 +45,23 @@
    rules for the [lazy] keyword.
 *)
 
-type 'a t = 'a lazy_t;;
+type 'a t = 'a lazy_t
 
-exception Undefined = CamlinternalLazy.Undefined;;
+exception Undefined = CamlinternalLazy.Undefined
 
-external make_forward : 'a -> 'a lazy_t = "caml_lazy_make_forward";;
+external make_forward : 'a -> 'a lazy_t = "caml_lazy_make_forward"
 
-external force : 'a t -> 'a = "%lazy_force";;
+external force : 'a t -> 'a = "%lazy_force"
 
-(* let force = force;; *)
+(* let force = force *)
 
-let force_val = CamlinternalLazy.force_val;;
+let force_val = CamlinternalLazy.force_val
 
 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 from_val (v : 'arg) =
   let t = Obj.tag (Obj.repr v) in
@@ -70,12 +70,12 @@ let from_val (v : 'arg) =
   end else begin
     (Obj.magic v : 'arg t)
   end
-;;
 
-let is_val (l : 'arg t) = Obj.tag (Obj.repr l) <> Obj.lazy_tag;;
 
-let lazy_from_fun = from_fun;;
+let is_val (l : 'arg t) = Obj.tag (Obj.repr l) <> Obj.lazy_tag
 
-let lazy_from_val = from_val;;
+let lazy_from_fun = from_fun
 
-let lazy_is_val = is_val;;
+let lazy_from_val = from_val
+
+let lazy_is_val = is_val

stdlib/lazy.mli

@@ -40,9 +40,9 @@ type 'a t = 'a lazy_t
 *)
 
 
-exception Undefined;;
+exception Undefined
 
-(* val force : 'a t -> 'a ;; *)
+(* val force : 'a t -> 'a  *)
 external force : 'a t -> 'a = "%lazy_force"
 (** [force x] forces the suspension [x] and returns its result.
    If [x] has already been forced, [Lazy.force x] returns the

stdlib/lexing.ml

@@ -69,7 +69,7 @@ let engine tbl state buf =
                        with pos_cnum = buf.lex_abs_pos + buf.lex_curr_pos};
   end;
   result
-;;
+
 
 let new_engine tbl state buf =
   let result = c_new_engine tbl state buf in
@@ -79,7 +79,7 @@ let new_engine tbl state buf =
                        with pos_cnum = buf.lex_abs_pos + buf.lex_curr_pos};
   end;
   result
-;;
+
 
 let lex_refill read_fun aux_buffer lexbuf =
   let read =
@@ -143,7 +143,7 @@ let zero_pos = {
   pos_lnum = 1;
   pos_bol = 0;
   pos_cnum = 0;
-};;
+}
 
 let from_function f =
   { refill_buff = lex_refill f (Bytes.create 512);
@@ -207,11 +207,11 @@ let sub_lexeme_char_opt lexbuf i =
 let lexeme_char lexbuf i =
   Bytes.get lexbuf.lex_buffer (lexbuf.lex_start_pos + i)
 
-let lexeme_start lexbuf = lexbuf.lex_start_p.pos_cnum;;
+let lexeme_start lexbuf = lexbuf.lex_start_p.pos_cnum
-let lexeme_end lexbuf = lexbuf.lex_curr_p.pos_cnum;;
+let lexeme_end lexbuf = lexbuf.lex_curr_p.pos_cnum
 
-let lexeme_start_p lexbuf = lexbuf.lex_start_p;;
+let lexeme_start_p lexbuf = lexbuf.lex_start_p
-let lexeme_end_p lexbuf = lexbuf.lex_curr_p;;
+let lexeme_end_p lexbuf = lexbuf.lex_curr_p
 
 let new_line lexbuf =
   let lcp = lexbuf.lex_curr_p in
@@ -219,7 +219,7 @@ let new_line lexbuf =
     pos_lnum = lcp.pos_lnum + 1;
     pos_bol = lcp.pos_cnum;
   }
-;;
+
 
 
 (* Discard data left in lexer buffer. *)
@@ -229,4 +229,3 @@ let flush_input lb =
   lb.lex_abs_pos <- 0;
   lb.lex_curr_p <- {lb.lex_curr_p with pos_cnum = 0};
   lb.lex_buffer_len <- 0;
-;;

stdlib/list.ml

@@ -70,7 +70,7 @@ let rev_map f l =
     | a::l -> rmap_f (f a :: accu) l
   in
   rmap_f [] l
-;;
+
 
 let rec iter f = function
     [] -> ()
@@ -106,7 +106,7 @@ let rev_map2 f l1 l2 =
     | (_, _) -> invalid_arg "List.rev_map2"
   in
   rmap2_f [] l1 l2
-;;
+
 
 let rec iter2 f l1 l2 =
   match (l1, l2) with
@@ -218,7 +218,7 @@ let rec merge cmp l1 l2 =
       if cmp h1 h2 <= 0
       then h1 :: merge cmp t1 l2
       else h2 :: merge cmp l1 t2
-;;
+
 
 let rec chop k l =
   if k = 0 then l else begin
@@ -226,7 +226,7 @@ let rec chop k l =
     | _::t -> chop (k-1) t
     | _ -> assert false
   end
-;;
+
 
 let stable_sort cmp l =
   let rec rev_merge l1 l2 accu =
@@ -292,10 +292,10 @@ let stable_sort cmp l =
   in
   let len = length l in
   if len < 2 then l else sort len l
-;;
 
-let sort = stable_sort;;
+
-let fast_sort = stable_sort;;
+let sort = stable_sort
+let fast_sort = stable_sort
 
 (* Note: on a list of length between about 100000 (depending on the minor
    heap size and the type of the list) and Sys.max_array_size, it is
@@ -320,13 +320,13 @@ let array_to_list_in_place a =
     end
   in
   loop [] (l-1000) l
-;;
+
 
 let stable_sort cmp l =
   let a = Array.of_list l in
   Array.stable_sort cmp a;
   array_to_list_in_place a
-;;
+
 *)
 
 
@@ -430,4 +430,3 @@ let sort_uniq cmp l =
   in
   let len = length l in
   if len < 2 then l else sort len l
-;;

stdlib/parsing.ml

@@ -195,15 +195,15 @@ let symbol_start_pos () =
     end
   in
   loop env.rule_len
-;;
-let symbol_end_pos () = env.symb_end_stack.(env.asp);;
-let rhs_start_pos n = env.symb_start_stack.(env.asp - (env.rule_len - n));;
-let rhs_end_pos n = env.symb_end_stack.(env.asp - (env.rule_len - n));;
 
-let symbol_start () = (symbol_start_pos ()).pos_cnum;;
+let symbol_end_pos () = env.symb_end_stack.(env.asp)
-let symbol_end () = (symbol_end_pos ()).pos_cnum;;
+let rhs_start_pos n = env.symb_start_stack.(env.asp - (env.rule_len - n))
-let rhs_start n = (rhs_start_pos n).pos_cnum;;
+let rhs_end_pos n = env.symb_end_stack.(env.asp - (env.rule_len - n))
-let rhs_end n = (rhs_end_pos n).pos_cnum;;
+
+let symbol_start () = (symbol_start_pos ()).pos_cnum
+let symbol_end () = (symbol_end_pos ()).pos_cnum
+let rhs_start n = (rhs_start_pos n).pos_cnum
+let rhs_end n = (rhs_end_pos n).pos_cnum
 
 let is_current_lookahead tok =
   (!current_lookahead_fun)(Obj.repr tok)

stdlib/pervasives.ml

@@ -256,9 +256,9 @@ let valid_float_lexem s =
     | _ -> s
   in
   loop 0
-;;
 
-let string_of_float f = valid_float_lexem (format_float "%.12g" f);;
+
+let string_of_float f = valid_float_lexem (format_float "%.12g" f)
 
 external float_of_string : string -> float = "caml_float_of_string"
 
@@ -438,7 +438,7 @@ external seek_in : in_channel -> int -> unit = "caml_ml_seek_in"
 external pos_in : in_channel -> int = "caml_ml_pos_in"
 external in_channel_length : in_channel -> int = "caml_ml_channel_size"
 external close_in : in_channel -> unit = "caml_ml_close_channel"
-let close_in_noerr ic = (try close_in ic with _ -> ());;
+let close_in_noerr ic = (try close_in ic with _ -> ())
 external set_binary_mode_in : in_channel -> bool -> unit
                             = "caml_ml_set_binary_mode"
 

stdlib/printexc.ml

@@ -13,11 +13,11 @@
 (*                                                                        *)
 (**************************************************************************)
 
-open Printf;;
+open Printf
 
 let printers = ref []
 
-let locfmt = format_of_string "File \"%s\", line %d, characters %d-%d: %s";;
+let locfmt = format_of_string "File \"%s\", line %d, characters %d-%d: %s"
 
 let field x i =
   let f = Obj.field x i in
@@ -29,18 +29,17 @@ let field x i =
     string_of_float (Obj.magic f : float)
   else
     "_"
-;;
+
 let rec other_fields x i =
   if i >= Obj.size x then ""
   else sprintf ", %s%s" (field x i) (other_fields x (i+1))
-;;
+
 let fields x =
   match Obj.size x with
   | 0 -> ""
   | 1 -> ""
   | 2 -> sprintf "(%s)" (field x 1)
   | _ -> sprintf "(%s%s)" (field x 1) (other_fields x 2)
-;;
 
 let to_string x =
   let rec conv = function

stdlib/random.ml

@@ -25,17 +25,17 @@
    passes all the Diehard tests.
 *)
 
-external random_seed: unit -> int array = "caml_sys_random_seed";;
+external random_seed: unit -> int array = "caml_sys_random_seed"
 
 module State = struct
 
-  type t = { st : int array; mutable idx : int };;
+  type t = { st : int array; mutable idx : int }
 
-  let new_state () = { st = Array.make 55 0; idx = 0 };;
+  let new_state () = { st = Array.make 55 0; idx = 0 }
   let assign st1 st2 =
     Array.blit st2.st 0 st1.st 0 55;
-    st1.idx <- st2.idx;
+    st1.idx <- st2.idx
-  ;;
+
 
   let full_init s seed =
     let combine accu x = Digest.string (accu ^ string_of_int x) in
@@ -55,22 +55,22 @@ module State = struct
       accu := combine !accu seed.(k);
       s.st.(j) <- (s.st.(j) lxor extract !accu) land 0x3FFFFFFF;  (* PR#5575 *)
     done;
-    s.idx <- 0;
+    s.idx <- 0
-  ;;
+
 
   let make seed =
     let result = new_state () in
     full_init result seed;
     result
-  ;;
 
-  let make_self_init () = make (random_seed ());;
+
+  let make_self_init () = make (random_seed ())
 
   let copy s =
     let result = new_state () in
     assign result s;
     result
-  ;;
+
 
   (* Returns 30 random bits as an integer 0 <= x < 1073741824 *)
   let bits s =
@@ -81,18 +81,18 @@ module State = struct
     let newval30 = newval land 0x3FFFFFFF in  (* PR#5575 *)
     s.st.(s.idx) <- newval30;
     newval30
-  ;;
+
 
   let rec intaux s n =
     let r = bits s in
     let v = r mod n in
     if r - v > 0x3FFFFFFF - n + 1 then intaux s n else v
-  ;;
+
   let int s bound =
     if bound > 0x3FFFFFFF || bound <= 0
     then invalid_arg "Random.int"
     else intaux s bound
-  ;;
+
 
   let rec int32aux s n =
     let b1 = Int32.of_int (bits s) in
@@ -102,12 +102,12 @@ module State = struct
     if Int32.sub r v > Int32.add (Int32.sub Int32.max_int n) 1l
     then int32aux s n
     else v
-  ;;
+
   let int32 s bound =
     if bound <= 0l
     then invalid_arg "Random.int32"
     else int32aux s bound
-  ;;
+
 
   let rec int64aux s n =
     let b1 = Int64.of_int (bits s) in
@@ -118,18 +118,18 @@ module State = struct
     if Int64.sub r v > Int64.add (Int64.sub Int64.max_int n) 1L
     then int64aux s n
     else v
-  ;;
+
   let int64 s bound =
     if bound <= 0L
     then invalid_arg "Random.int64"
     else int64aux s bound
-  ;;
+
 
   let nativeint =
     if Nativeint.size = 32
     then fun s bound -> Nativeint.of_int32 (int32 s (Nativeint.to_int32 bound))
     else fun s bound -> Int64.to_nativeint (int64 s (Int64.of_nativeint bound))
-  ;;
+
 
   (* Returns a float 0 <= x <= 1 with at most 60 bits of precision. *)
   let rawfloat s =
@@ -137,13 +137,13 @@ module State = struct
     and r1 = Pervasives.float (bits s)
     and r2 = Pervasives.float (bits s)
     in (r1 /. scale +. r2) /. scale
-  ;;
 
-  let float s bound = rawfloat s *. bound;;
 
-  let bool s = (bits s land 1 = 0);;
+  let float s bound = rawfloat s *. bound
 
-end;;
+  let bool s = (bits s land 1 = 0)
+
+end
 
 (* This is the state you get with [init 27182818] and then applying
    the "land 0x3FFFFFFF" filter to them.  See #5575, #5793, #5977. *)
@@ -161,24 +161,24 @@ let default = {
       0x2fbf967a;
     |];
   State.idx = 0;
-};;
+}
 
-let bits () = State.bits default;;
+let bits () = State.bits default
-let int bound = State.int default bound;;
+let int bound = State.int default bound
-let int32 bound = State.int32 default bound;;
+let int32 bound = State.int32 default bound
-let nativeint bound = State.nativeint default bound;;
+let nativeint bound = State.nativeint default bound
-let int64 bound = State.int64 default bound;;
+let int64 bound = State.int64 default bound
-let float scale = State.float default scale;;
+let float scale = State.float default scale
-let bool () = State.bool default;;
+let bool () = State.bool default
 
-let full_init seed = State.full_init default seed;;
+let full_init seed = State.full_init default seed
-let init seed = State.full_init default [| seed |];;
+let init seed = State.full_init default [| seed |]
-let self_init () = full_init (random_seed());;
+let self_init () = full_init (random_seed())
 
 (* Manipulating the current state. *)
 
-let get_state () = State.copy default;;
+let get_state () = State.copy default
-let set_state s = State.assign default s;;
+let set_state s = State.assign default s
 
 (********************
 
@@ -190,19 +190,19 @@ let set_state s = State.assign default s;;
 
   Some results:
 
-init 27182818; chisquare int 100000 1000;;
+init 27182818; chisquare int 100000 1000
-init 27182818; chisquare int 100000 100;;
+init 27182818; chisquare int 100000 100
-init 27182818; chisquare int 100000 5000;;
+init 27182818; chisquare int 100000 5000
-init 27182818; chisquare int 1000000 1000;;
+init 27182818; chisquare int 1000000 1000
-init 27182818; chisquare int 100000 1024;;
+init 27182818; chisquare int 100000 1024
-init 299792643; chisquare int 100000 1024;;
+init 299792643; chisquare int 100000 1024
-init 14142136; chisquare int 100000 1024;;
+init 14142136; chisquare int 100000 1024
-init 27182818; init_diff 1024; chisquare diff 100000 1024;;
+init 27182818; init_diff 1024; chisquare diff 100000 1024
-init 27182818; init_diff 100; chisquare diff 100000 100;;
+init 27182818; init_diff 100; chisquare diff 100000 100
-init 27182818; init_diff2 1024; chisquare diff2 100000 1024;;
+init 27182818; init_diff2 1024; chisquare diff2 100000 1024
-init 27182818; init_diff2 100; chisquare diff2 100000 100;;
+init 27182818; init_diff2 100; chisquare diff2 100000 100
-init 14142136; init_diff2 100; chisquare diff2 100000 100;;
+init 14142136; init_diff2 100; chisquare diff2 100000 100
-init 299792643; init_diff2 100; chisquare diff2 100000 100;;
+init 299792643; init_diff2 100; chisquare diff2 100000 100
 - : float * float * float = (936.754446796632465, 997.5, 1063.24555320336754)
 # - : float * float * float = (80., 89.7400000000052387, 120.)
 # - : float * float * float = (4858.57864376269, 5045.5, 5141.42135623731)
@@ -225,7 +225,7 @@ 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 sumsq v i0 ((i0+i1)/2) +. sumsq v ((i0+i1)/2) i1
-;;
+
 
 let chisquare g n r =
   if n <= 10 * r then invalid_arg "chisquare";
@@ -239,12 +239,12 @@ let chisquare g n r =
   and n = Pervasives.float n in
   let sr = 2.0 *. sqrt r in
   (r -. sr,   (r *. t /. n) -. n,   r +. sr)
-;;
+
 
 (* This is to test for linear dependencies between successive random numbers.
 *)
-let st = ref 0;;
+let st = ref 0
-let init_diff r = st := int r;;
+let init_diff r = st := int r
 let diff r =
   let x1 = !st
   and x2 = int r
@@ -254,16 +254,16 @@ let diff r =
     x1 - x2
   else
     r + x1 - x2
-;;
+
 
 let st1 = ref 0
 and st2 = ref 0
-;;
+
 
 (* This is to test for quadratic dependencies between successive random
    numbers.
 *)
-let init_diff2 r = st1 := int r; st2 := int r;;
+let init_diff2 r = st1 := int r; st2 := int r
 let diff2 r =
   let x1 = !st1
   and x2 = !st2
@@ -272,6 +272,6 @@ let diff2 r =
   st1 := x2;
   st2 := x3;
   (x3 - x2 - x2 + x1 + 2*r) mod r
-;;
+
 
 ********************)

stdlib/random.mli

@@ -97,7 +97,7 @@ module State : sig
   (** These functions are the same as the basic functions, except that they
       use (and update) the given PRNG state instead of the default one.
   *)
-end;;
+end
 
 
 val get_state : unit -> State.t

stdlib/scanf.ml

@@ -25,129 +25,129 @@ open CamlinternalFormat
 *)
 type ('a, 'b, 'c, 'd, 'e, 'f) format6 =
   ('a, 'b, 'c, 'd, 'e, 'f) Pervasives.format6
-;;
+
 
 (* The run-time library for scanners. *)
 
 (* Scanning buffers. *)
 module type SCANNING = sig
 
-  type in_channel;;
+  type in_channel
 
-  type scanbuf = in_channel;;
+  type scanbuf = in_channel
 
-  type file_name = string;;
+  type file_name = string
 
-  val stdin : in_channel;;
+  val stdin : in_channel
   (* The scanning buffer reading from [Pervasives.stdin].
      [stdib] is equivalent to [Scanning.from_channel Pervasives.stdin]. *)
 
-  val stdib : in_channel;;
+  val stdib : in_channel
   (* An alias for [Scanf.stdin], the scanning buffer reading from
      [Pervasives.stdin]. *)
 
-  val next_char : scanbuf -> char;;
+  val next_char : scanbuf -> char
   (* [Scanning.next_char ib] advance the scanning buffer for
      one character.
      If no more character can be read, sets a end of file condition and
      returns '\000'. *)
 
-  val invalidate_current_char : scanbuf -> unit;;
+  val invalidate_current_char : scanbuf -> unit
   (* [Scanning.invalidate_current_char ib] mark the current_char as already
      scanned. *)
 
-  val peek_char : scanbuf -> char;;
+  val peek_char : scanbuf -> char
   (* [Scanning.peek_char ib] returns the current char available in
      the buffer or reads one if necessary (when the current character is
      already scanned).
      If no character can be read, sets an end of file condition and
      returns '\000'. *)
 
-  val checked_peek_char : scanbuf -> char;;
+  val checked_peek_char : scanbuf -> char
   (* Same as [Scanning.peek_char] above but always returns a valid char or
      fails: instead of returning a null char when the reading method of the
      input buffer has reached an end of file, the function raises exception
      [End_of_file]. *)
 
-  val store_char : int -> scanbuf -> char -> int;;
+  val store_char : int -> scanbuf -> char -> int
   (* [Scanning.store_char lim ib c] adds [c] to the token buffer
      of the scanning buffer [ib]. It also advances the scanning buffer for
      one character and returns [lim - 1], indicating the new limit for the
      length of the current token. *)
 
-  val skip_char : int -> scanbuf -> int;;
+  val skip_char : int -> scanbuf -> int
   (* [Scanning.skip_char lim ib] ignores the current character. *)
 
-  val ignore_char : int -> scanbuf -> int;;
+  val ignore_char : int -> scanbuf -> int
   (* [Scanning.ignore_char ib lim] ignores the current character and
      decrements the limit. *)
 
-  val token : scanbuf -> string;;
+  val token : scanbuf -> string
   (* [Scanning.token ib] returns the string stored into the token
      buffer of the scanning buffer: it returns the token matched by the
      format. *)
 
-  val reset_token : scanbuf -> unit;;
+  val reset_token : scanbuf -> unit
   (* [Scanning.reset_token ib] resets the token buffer of
      the given scanning buffer. *)
 
-  val char_count : scanbuf -> int;;
+  val char_count : scanbuf -> int
   (* [Scanning.char_count ib] returns the number of characters
      read so far from the given buffer. *)
 
-  val line_count : scanbuf -> int;;
+  val line_count : scanbuf -> int
   (* [Scanning.line_count ib] returns the number of new line
      characters read so far from the given buffer. *)
 
-  val token_count : scanbuf -> int;;
+  val token_count : scanbuf -> int
   (* [Scanning.token_count ib] returns the number of tokens read
      so far from [ib]. *)
 
-  val eof : scanbuf -> bool;;
+  val eof : scanbuf -> bool
   (* [Scanning.eof ib] returns the end of input condition
      of the given buffer. *)
 
-  val end_of_input : scanbuf -> bool;;
+  val end_of_input : scanbuf -> bool
   (* [Scanning.end_of_input ib] tests the end of input condition
      of the given buffer (if no char has ever been read, an attempt to
      read one is performed). *)
 
-  val beginning_of_input : scanbuf -> bool;;
+  val beginning_of_input : scanbuf -> bool
   (* [Scanning.beginning_of_input ib] tests the beginning of input
      condition of the given buffer. *)
 
-  val name_of_input : scanbuf -> string;;
+  val name_of_input : scanbuf -> string
   (* [Scanning.name_of_input ib] returns the name of the character
      source for input buffer [ib]. *)
 
-  val open_in : file_name -> in_channel;;
+  val open_in : file_name -> in_channel
-  val open_in_bin : file_name -> in_channel;;
+  val open_in_bin : file_name -> in_channel
-  val from_file : file_name -> in_channel;;
+  val from_file : file_name -> in_channel
-  val from_file_bin : file_name -> in_channel;;
+  val from_file_bin : file_name -> in_channel
-  val from_string : string -> in_channel;;
+  val from_string : string -> in_channel
-  val from_function : (unit -> char) -> in_channel;;
+  val from_function : (unit -> char) -> in_channel
-  val from_channel : Pervasives.in_channel -> in_channel;;
+  val from_channel : Pervasives.in_channel -> in_channel
 
-  val close_in : in_channel -> unit;;
+  val close_in : in_channel -> unit
 
-  val memo_from_channel : Pervasives.in_channel -> in_channel;;
+  val memo_from_channel : Pervasives.in_channel -> in_channel
   (* Obsolete. *)
 
 end
-;;
+
 
 module Scanning : SCANNING = struct
 
   (* The run-time library for scanf. *)
 
-  type file_name = string;;
+  type file_name = string
 
   type in_channel_name =
     | From_channel of Pervasives.in_channel
     | From_file of file_name * Pervasives.in_channel
     | From_function
     | From_string
-  ;;
+
 
   type in_channel = {
     mutable ic_eof : bool;
@@ -160,11 +160,11 @@ module Scanning : SCANNING = struct
     ic_token_buffer : Buffer.t;
     ic_input_name : in_channel_name;
   }
-  ;;
 
-  type scanbuf = in_channel;;
 
-  let null_char = '\000';;
+  type scanbuf = in_channel
+
+  let null_char = '\000'
 
   (* Reads a new character from input buffer.
      Next_char never fails, even in case of end of input:
@@ -183,13 +183,13 @@ module Scanning : SCANNING = struct
       ib.ic_current_char_is_valid <- false;
       ib.ic_eof <- true;
       c
-  ;;
+
 
   let peek_char ib =
     if ib.ic_current_char_is_valid
     then ib.ic_current_char
     else next_char ib
-  ;;
+
 
   (* Returns a valid current char for the input buffer. In particular
      no irrelevant null character (as set by [next_char] in case of end
@@ -200,16 +200,16 @@ module Scanning : SCANNING = struct
     let c = peek_char ib in
     if ib.ic_eof then raise End_of_file;
     c
-  ;;
+
 
   let end_of_input ib =
     ignore (peek_char ib);
     ib.ic_eof
-  ;;
 
-  let eof ib = ib.ic_eof;;
 
-  let beginning_of_input ib = ib.ic_char_count = 0;;
+  let eof ib = ib.ic_eof
+
+  let beginning_of_input ib = ib.ic_char_count = 0
 
   let name_of_input ib =
     match ib.ic_input_name with
@@ -217,19 +217,19 @@ module Scanning : SCANNING = struct
     | From_file (fname, _ic) -> fname
     | From_function -> "unnamed function"
     | From_string -> "unnamed character string"
-  ;;
+
 
   let char_count ib =
     if ib.ic_current_char_is_valid
     then ib.ic_char_count - 1
     else ib.ic_char_count
-  ;;
 
-  let line_count ib = ib.ic_line_count;;
 
-  let reset_token ib = Buffer.reset ib.ic_token_buffer;;
+  let line_count ib = ib.ic_line_count
 
-  let invalidate_current_char ib = ib.ic_current_char_is_valid <- false;;
+  let reset_token ib = Buffer.reset ib.ic_token_buffer
+
+  let invalidate_current_char ib = ib.ic_current_char_is_valid <- false
 
   let token ib =
     let token_buffer = ib.ic_token_buffer in
@@ -237,23 +237,23 @@ module Scanning : SCANNING = struct
     Buffer.clear token_buffer;
     ib.ic_token_count <- succ ib.ic_token_count;
     tok
-  ;;
 
-  let token_count ib = ib.ic_token_count;;
+
+  let token_count ib = ib.ic_token_count
 
   let skip_char width ib =
     invalidate_current_char ib;
     width
-  ;;
 
-  let ignore_char width ib = skip_char (width - 1) ib;;
+
+  let ignore_char width ib = skip_char (width - 1) ib
 
   let store_char width ib c =
     Buffer.add_char ib.ic_token_buffer c;
     ignore_char width ib
-  ;;
 
-  let default_token_buffer_size = 1024;;
+
+  let default_token_buffer_size = 1024
 
   let create iname next = {
     ic_eof = false;
@@ -266,7 +266,7 @@ module Scanning : SCANNING = struct
     ic_token_buffer = Buffer.create default_token_buffer_size;
     ic_input_name = iname;
   }
-  ;;
+
 
   let from_string s =
     let i = ref 0 in
@@ -277,9 +277,9 @@ module Scanning : SCANNING = struct
       incr i;
       c in
     create From_string next
-  ;;
 
-  let from_function = create From_function;;
+
+  let from_function = create From_function
 
   (* Scanning from an input channel. *)
 
@@ -322,14 +322,14 @@ module Scanning : SCANNING = struct
   *)
 
   (* Perform bufferized input to improve efficiency. *)
-  let file_buffer_size = ref 1024;;
+  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 = Pervasives.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]. *)
-  let scan_raise_at_end _ic = raise End_of_file;;
+  let scan_raise_at_end _ic = raise End_of_file
 
   let from_ic scan_close_ic iname ic =
     let len = !file_buffer_size in
@@ -347,10 +347,10 @@ module Scanning : SCANNING = struct
         end
       end in
     create iname next
-  ;;
 
-  let from_ic_close_at_end = from_ic scan_close_at_end;;
+
-  let from_ic_raise_at_end = from_ic scan_raise_at_end;;
+  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].
      One could try to define [stdib] as a scanning buffer reading a character
@@ -370,9 +370,9 @@ module Scanning : SCANNING = struct
   let stdin =
     from_ic scan_raise_at_end
       (From_file ("-", Pervasives.stdin)) Pervasives.stdin
-  ;;
 
-  let stdib = stdin;;
+
+  let stdib = stdin
 
   let open_in_file open_in fname =
     match fname with
@@ -380,17 +380,17 @@ module Scanning : SCANNING = struct
     | fname ->
       let ic = open_in fname in
       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 from_file = open_in;;
+  let open_in = open_in_file Pervasives.open_in
-  let from_file_bin = open_in_bin;;
+  let open_in_bin = open_in_file Pervasives.open_in_bin
+
+  let from_file = open_in
+  let from_file_bin = open_in_bin
 
   let from_channel ic =
     from_ic_raise_at_end (From_channel ic) ic
-  ;;
+
 
   let close_in ib =
     match ib.ic_input_name with
@@ -398,7 +398,7 @@ module Scanning : SCANNING = struct
       Pervasives.close_in ic
     | From_file (_fname, ic) -> Pervasives.close_in ic
     | From_function | From_string -> ()
-  ;;
+
 
   (*
      Obsolete: a memo [from_channel] version to build a [Scanning.in_channel]
@@ -424,28 +424,28 @@ module Scanning : SCANNING = struct
          from_ic scan_close_ic (From_channel ic) ic in
        memo := (ic, ib) :: !memo;
        ib)
-  ;;
+
 
   (* Obsolete: see {!memo_from_ic} above. *)
-  let memo_from_channel = memo_from_ic scan_raise_at_end;;
+  let memo_from_channel = memo_from_ic scan_raise_at_end
 
 end
-;;
+
 
 (* Formatted input functions. *)
 
 type ('a, 'b, 'c, 'd) scanner =
      ('a, Scanning.in_channel, 'b, 'c, 'a -> 'd, 'd) format6 -> 'c
-;;
+
 
 (* Reporting errors. *)
-exception Scan_failure of string;;
+exception Scan_failure of string
 
-let bad_input s = raise (Scan_failure s);;
+let bad_input s = raise (Scan_failure s)
 
 let bad_input_escape c =
   bad_input (Printf.sprintf "illegal escape character %C" c)
-;;
+
 
 let bad_token_length message =
   bad_input
@@ -453,7 +453,7 @@ let bad_token_length message =
        "scanning of %s failed: \
         the specified length was too short for token"
        message)
-;;
+
 
 let bad_end_of_input message =
   bad_input
@@ -461,23 +461,23 @@ let bad_end_of_input message =
        "scanning of %s failed: \
         premature end of file occurred before end of token"
        message)
-;;
+
 
 let bad_float () =
   bad_input "no dot or exponent part found in float token"
-;;
+
 
 let bad_hex_float () =
   bad_input "not a valid float in hexadecimal notation"
-;;
+
 
 let character_mismatch_err c ci =
   Printf.sprintf "looking for %C, found %C" c ci
-;;
+
 
 let character_mismatch c ci =
   bad_input (character_mismatch_err c ci)
-;;
+
 
 let rec skip_whites ib =
   let c = Scanning.peek_char ib in
@@ -487,7 +487,7 @@ let rec skip_whites ib =
       Scanning.invalidate_current_char ib; skip_whites ib
     | _ -> ()
   end
-;;
+
 
 (* Checking that [c] is indeed in the input, then skips it.
    In this case, the character [c] has been explicitly specified in the
@@ -520,20 +520,20 @@ and check_newline ib =
   | '\n' -> Scanning.invalidate_current_char ib
   | '\r' -> Scanning.invalidate_current_char ib; check_this_char ib '\n'
   | _ -> character_mismatch '\n' ci
-;;
+
 
 (* Extracting tokens from the output token buffer. *)
 
-let token_char ib = (Scanning.token ib).[0];;
+let token_char ib = (Scanning.token ib).[0]
 
-let token_string = Scanning.token;;
+let token_string = Scanning.token
 
 let token_bool ib =
   match Scanning.token ib with
   | "true" -> true
   | "false" -> false
   | s -> bad_input (Printf.sprintf "invalid boolean '%s'" s)
-;;
+
 
 (* The type of integer conversions. *)
 type integer_conversion =
@@ -543,7 +543,7 @@ type integer_conversion =
   | O_conversion (* Unsigned octal conversion *)
   | U_conversion (* Unsigned decimal conversion *)
   | X_conversion (* Unsigned hexadecimal conversion *)
-;;
+
 
 let integer_conversion_of_char = function
   | 'b' -> B_conversion
@@ -553,7 +553,7 @@ let integer_conversion_of_char = function
   | 'u' -> U_conversion
   | 'x' | 'X' -> X_conversion
   | _ -> assert false
-;;
+
 
 (* Extract an integer literal token.
    Since the functions Pervasives.*int*_of_string do not accept a leading +,
@@ -568,14 +568,14 @@ let token_int_literal conv ib =
     | B_conversion -> "0b" ^ Scanning.token ib in
   let l = String.length tok in
   if l = 0 || tok.[0] <> '+' then tok else String.sub tok 1 (l - 1)
-;;
+
 
 (* All the functions that convert a string to a number raise the exception
    Failure when the conversion is not possible.
    This exception is then trapped in [kscanf]. *)
-let token_int conv ib = int_of_string (token_int_literal conv ib);;
+let token_int conv ib = int_of_string (token_int_literal conv ib)
 
-let token_float ib = float_of_string (Scanning.token ib);;
+let token_float ib = float_of_string (Scanning.token ib)
 
 (* To scan native ints, int32 and int64 integers.
    We cannot access to conversions to/from strings for those types,
@@ -585,17 +585,17 @@ let token_float ib = float_of_string (Scanning.token ib);;
    available in the runtime. *)
 external nativeint_of_string : string -> nativeint
   = "caml_nativeint_of_string"
-;;
+
 external int32_of_string : string -> int32
   = "caml_int32_of_string"
-;;
+
 external int64_of_string : string -> int64
   = "caml_int64_of_string"
-;;
 
-let token_nativeint conv ib = nativeint_of_string (token_int_literal conv ib);;
+
-let token_int32 conv ib = int32_of_string (token_int_literal conv ib);;
+let token_nativeint conv ib = nativeint_of_string (token_int_literal conv ib)
-let token_int64 conv ib = int64_of_string (token_int_literal conv ib);;
+let token_int32 conv ib = int32_of_string (token_int_literal conv ib)
+let token_int64 conv ib = int64_of_string (token_int_literal conv ib)
 
 (* Scanning numbers. *)
 
@@ -622,7 +622,7 @@ let rec scan_decimal_digit_star width ib =
     let width = Scanning.ignore_char width ib in
     scan_decimal_digit_star width ib
   | _ -> width
-;;
+
 
 let scan_decimal_digit_plus width ib =
   if width = 0 then bad_token_length "decimal digits" else
@@ -633,7 +633,7 @@ let scan_decimal_digit_plus width ib =
     scan_decimal_digit_star width ib
   | c ->
     bad_input (Printf.sprintf "character %C is not a decimal digit" c)
-;;
+
 
 (* To scan numbers from other bases, we use a predicate argument to
    scan digits. *)
@@ -651,7 +651,7 @@ let scan_digit_star digitp width ib =
       scan_digits width ib
     | _ -> width in
   scan_digits width ib
-;;
+
 
 let scan_digit_plus basis digitp width ib =
   (* Ensure we have got enough width left,
@@ -663,31 +663,31 @@ let scan_digit_plus basis digitp width ib =
     scan_digit_star digitp width ib
   else
     bad_input (Printf.sprintf "character %C is not a valid %s digit" c basis)
-;;
+
 
 let is_binary_digit = function
   | '0' .. '1' -> true
   | _ -> false
-;;
 
-let scan_binary_int = scan_digit_plus "binary" is_binary_digit;;
+
+let scan_binary_int = scan_digit_plus "binary" is_binary_digit
 
 let is_octal_digit = function
   | '0' .. '7' -> true
   | _ -> false
-;;
 
-let scan_octal_int = scan_digit_plus "octal" is_octal_digit;;
+
+let scan_octal_int = scan_digit_plus "octal" is_octal_digit
 
 let is_hexa_digit = function
   | '0' .. '9' | 'a' .. 'f' | 'A' .. 'F' -> true
   | _ -> false
-;;
 
-let scan_hexadecimal_int = scan_digit_plus "hexadecimal" is_hexa_digit;;
+
+let scan_hexadecimal_int = scan_digit_plus "hexadecimal" is_hexa_digit
 
 (* Scan a decimal integer. *)
-let scan_unsigned_decimal_int = scan_decimal_digit_plus;;
+let scan_unsigned_decimal_int = scan_decimal_digit_plus
 
 let scan_sign width ib =
   let c = Scanning.checked_peek_char ib in
@@ -695,12 +695,12 @@ let scan_sign width ib =
   | '+' -> Scanning.store_char width ib c
   | '-' -> Scanning.store_char width ib c
   | _ -> width
-;;
+
 
 let scan_optionally_signed_decimal_int width ib =
   let width = scan_sign width ib in
   scan_unsigned_decimal_int width ib
-;;
+
 
 (* Scan an unsigned integer that could be given in any (common) basis.
    If digits are prefixed by one of 0x, 0X, 0o, or 0b, the number is
@@ -719,12 +719,12 @@ let scan_unsigned_int width ib =
     | 'b' -> scan_binary_int (Scanning.store_char width ib c) ib
     | _ -> scan_decimal_digit_star width ib end
   | _ -> scan_unsigned_decimal_int width ib
-;;
+
 
 let scan_optionally_signed_int width ib =
   let width = scan_sign width ib in
   scan_unsigned_int width ib
-;;
+
 
 let scan_int_conversion conv width ib =
   match conv with
@@ -734,7 +734,7 @@ let scan_int_conversion conv width ib =
   | O_conversion -> scan_octal_int width ib
   | U_conversion -> scan_unsigned_decimal_int width ib
   | X_conversion -> scan_hexadecimal_int width ib
-;;
+
 
 (* Scanning floating point numbers. *)
 
@@ -747,7 +747,7 @@ let scan_fractional_part width ib =
   | '0' .. '9' as c ->
     scan_decimal_digit_star (Scanning.store_char width ib c) ib
   | _ -> width
-;;
+
 
 (* Exp part is optional and can be reduced to 0 digits. *)
 let scan_exponent_part width ib =
@@ -758,7 +758,7 @@ let scan_exponent_part width ib =
   | 'e' | 'E' as c ->
     scan_optionally_signed_decimal_int (Scanning.store_char width ib c) ib
   | _ -> width
-;;
+
 
 (* Scan the integer part of a floating point number, (not using the
    OCaml lexical convention since the integer part can be empty):
@@ -767,7 +767,7 @@ let scan_exponent_part width ib =
 let scan_integer_part width ib =
   let width = scan_sign width ib in
   scan_decimal_digit_star width ib
-;;
+
 
 (*
    For the time being we have (as found in scanf.mli):
@@ -813,7 +813,7 @@ let scan_float width precision ib =
     scan_exponent_part width ib, precision
   | _ ->
     scan_exponent_part width ib, precision
-;;
+
 
 let check_case_insensitive_string width ib error str =
   let lowercase c =
@@ -830,7 +830,7 @@ let check_case_insensitive_string width ib error str =
     width := Scanning.store_char !width ib c;
   done;
   !width
-;;
+
 
 let scan_hex_float width precision ib =
   if width = 0 || Scanning.end_of_input ib then bad_hex_float ();
@@ -874,7 +874,7 @@ let scan_hex_float width precision ib =
     if width = 0 || Scanning.end_of_input ib then bad_hex_float ();
     check_case_insensitive_string width ib bad_hex_float "nfinity"
   | _ -> bad_hex_float ()
-;;
+
 
 let scan_caml_float_rest width precision ib =
   if width = 0 || Scanning.end_of_input ib then bad_float ();
@@ -899,7 +899,7 @@ let scan_caml_float_rest width precision ib =
   | 'e' | 'E' ->
     scan_exponent_part width ib
   | _ -> bad_float ()
-;;
+
 
 let scan_caml_float width precision ib =
   if width = 0 || Scanning.end_of_input ib then bad_float ();
@@ -947,7 +947,7 @@ let scan_caml_float width precision ib =
   | 'n' ->
 *)
   | _ -> bad_float ()
-;;
+
 
 (* Scan a regular string:
    stops when encountering a space, if no scanning indication has been given;
@@ -968,7 +968,7 @@ let scan_string stp width ib =
         | ' ' | '\t' | '\n' | '\r' -> width
         | _ -> loop (Scanning.store_char width ib c) in
   loop width
-;;
+
 
 (* Scan a char: peek strictly one character in the input, whatsoever. *)
 let scan_char width ib =
@@ -976,7 +976,7 @@ let scan_char width ib =
      calling scan_char, in the main scanning function.
     if width = 0 then bad_token_length "a character" else *)
   Scanning.store_char width ib (Scanning.checked_peek_char ib)
-;;
+
 
 let char_for_backslash = function
   | 'n' -> '\010'
@@ -984,11 +984,11 @@ let char_for_backslash = function
   | 'b' -> '\008'
   | 't' -> '\009'
   | c -> c
-;;
+
 
 (* The integer value corresponding to the facial value of a valid
    decimal digit character. *)
-let decimal_value_of_char c = int_of_char c - int_of_char '0';;
+let decimal_value_of_char c = int_of_char c - int_of_char '0'
 
 let char_for_decimal_code c0 c1 c2 =
   let c =
@@ -1000,7 +1000,7 @@ let char_for_decimal_code c0 c1 c2 =
       (Printf.sprintf
          "bad character decimal encoding \\%c%c%c" c0 c1 c2) else
   char_of_int c
-;;
+
 
 (* The integer value corresponding to the facial value of a valid
    hexadecimal digit character. *)
@@ -1016,7 +1016,7 @@ let hexadecimal_value_of_char c =
   if d >= int_of_char 'A' then
     d - 55  (* 10 + int_of_char c - int_of_char 'A' *) else
     d - int_of_char '0'
-;;
+
 
 let char_for_hexadecimal_code c1 c2 =
   let c =
@@ -1026,7 +1026,7 @@ let char_for_hexadecimal_code c1 c2 =
     bad_input
       (Printf.sprintf "bad character hexadecimal encoding \\%c%c" c1 c2) else
   char_of_int c
-;;
+
 
 (* Called in particular when encountering '\\' as starter of a char.
    Stops before the corresponding '\''. *)
@@ -1035,10 +1035,10 @@ let check_next_char message width ib =
   let c = Scanning.peek_char ib in
   if Scanning.eof ib then bad_end_of_input message else
   c
-;;
 
-let check_next_char_for_char = check_next_char "a Char";;
+
-let check_next_char_for_string = check_next_char "a String";;
+let check_next_char_for_char = check_next_char "a Char"
+let check_next_char_for_string = check_next_char "a String"
 
 let scan_backslash_char width ib =
   match check_next_char_for_char width ib with
@@ -1065,7 +1065,7 @@ let scan_backslash_char width ib =
     Scanning.store_char (width - 2) ib (char_for_hexadecimal_code c1 c2)
   | c ->
     bad_input_escape c
-;;
+
 
 (* Scan a character (an OCaml token). *)
 let scan_caml_char width ib =
@@ -1088,7 +1088,7 @@ let scan_caml_char width ib =
     | c -> character_mismatch '\'' c in
 
   find_start width
-;;
+
 
 (* Scan a delimited string (an OCaml token). *)
 let scan_caml_string width ib =
@@ -1121,7 +1121,7 @@ let scan_caml_string width ib =
     | _ -> find_stop width in
 
   find_start width
-;;
+
 
 (* Scan a boolean (an OCaml token). *)
 let scan_bool ib =
@@ -1134,7 +1134,7 @@ let scan_bool ib =
       bad_input
         (Printf.sprintf "the character %C cannot start a boolean" c) in
   scan_string None m ib
-;;
+
 
 (* Scan a string containing elements in char_set and terminated by scan_indic
    if provided. *)
@@ -1155,7 +1155,7 @@ let scan_chars_in_char_set char_set scan_indic width ib =
       if c = ci
       then Scanning.invalidate_current_char ib
       else character_mismatch c ci
-;;
+
 
 (* The global error report function for [Scanf]. *)
 let scanf_bad_input ib = function
@@ -1163,7 +1163,7 @@ let scanf_bad_input ib = function
     let i = Scanning.char_count ib in
     bad_input (Printf.sprintf "scanf: bad input at char number %i: %s" i s)
   | x -> raise x
-;;
+
 
 (* Get the content of a counter from an input buffer. *)
 let get_counter ib counter =
@@ -1171,13 +1171,13 @@ let get_counter ib counter =
   | Line_counter -> Scanning.line_count ib
   | Char_counter -> Scanning.char_count ib
   | Token_counter -> Scanning.token_count ib
-;;
+
 
 (* Compute the width of a padding option (see "%42{" and "%123("). *)
 let width_of_pad_opt pad_opt = match pad_opt with
   | None -> max_int
   | Some width -> width
-;;
+
 
 let stopper_of_formatting_lit fmting =
   if fmting = Escaped_percent then '%', "" else
@@ -1185,7 +1185,7 @@ let stopper_of_formatting_lit fmting =
     let stp = str.[1] in
     let sub_str = String.sub str 2 (String.length str - 2) in
     stp, sub_str
-;;
+
 
 (******************************************************************************)
                            (* Readers managment *)
@@ -1404,7 +1404,7 @@ fun ib fmt readers -> match fmt with
            are typed in the same way.
 
            # Scanf.sscanf "\"%_r%d\"3" "%(%d%_r%)" ignore
-             (fun fmt n -> string_of_format fmt, n);;
+             (fun fmt n -> string_of_format fmt, n)
            Exception: CamlinternalFormat.Type_mismatch.
 
            We should properly catch this exception.
@@ -1515,13 +1515,13 @@ let kscanf ib ef (Format (fmt, str)) =
 
 (***)
 
-let kbscanf = kscanf;;
+let kbscanf = kscanf
-let bscanf ib fmt = kbscanf ib scanf_bad_input fmt;;
+let bscanf ib fmt = kbscanf ib scanf_bad_input fmt
 
-let ksscanf s ef fmt = kbscanf (Scanning.from_string s) ef fmt;;
+let ksscanf s ef fmt = kbscanf (Scanning.from_string s) ef fmt
-let sscanf s fmt = kbscanf (Scanning.from_string s) scanf_bad_input fmt;;
+let sscanf s fmt = kbscanf (Scanning.from_string s) scanf_bad_input fmt
 
-let scanf fmt = kscanf Scanning.stdib scanf_bad_input fmt;;
+let scanf fmt = kscanf Scanning.stdib scanf_bad_input fmt
 
 (***)
 
@@ -1536,13 +1536,13 @@ let bscanf_format :
       try format_of_string_format str format
       with Failure msg -> bad_input msg in
     f fmt'
-;;
+
 
 let sscanf_format :
   string -> ('a, 'b, 'c, 'd, 'e, 'f) format6 ->
   (('a, 'b, 'c, 'd, 'e, 'f) format6 -> 'g) -> 'g =
   fun s format f -> bscanf_format (Scanning.from_string s) format f
-;;
+
 
 let string_to_String s =
   let l = String.length s in
@@ -1555,16 +1555,16 @@ let string_to_String s =
   done;
   Buffer.add_char b '\"';
   Buffer.contents b
-;;
+
 
 let format_from_string s fmt =
   sscanf_format (string_to_String s) fmt (fun x -> x)
-;;
+
 
 let unescaped s =
   sscanf ("\"" ^ s ^ "\"") "%S%!" (fun x -> x)
-;;
+
 
 (* Deprecated *)
-let kfscanf ic ef fmt = kbscanf (Scanning.memo_from_channel ic) ef fmt;;
+let kfscanf ic ef fmt = kbscanf (Scanning.memo_from_channel ic) ef fmt
-let fscanf ic fmt = kscanf (Scanning.memo_from_channel ic) scanf_bad_input fmt;;
+let fscanf ic fmt = kscanf (Scanning.memo_from_channel ic) scanf_bad_input fmt

stdlib/stream.ml

@@ -25,9 +25,9 @@ and 'a data =
 and 'a gen = { mutable curr : 'a option option; func : int -> 'a option }
 and buffio =
   { ic : in_channel; buff : bytes; mutable len : int; mutable ind : int }
-;;
+
-exception Failure;;
+exception Failure
-exception Error of string;;
+exception Error of string
 
 let count = function
   | None -> 0
@@ -38,7 +38,7 @@ let data = function
 
 let fill_buff b =
   b.len <- input b.ic b.buff 0 (Bytes.length b.buff); b.ind <- 0
-;;
+
 
 let rec get_data : type v. int -> v data -> v data = fun count d -> match d with
  (* Returns either Sempty or Scons(a, _) even when d is a generator
@@ -68,7 +68,7 @@ let rec get_data : type v. int -> v data -> v data = fun count d -> match d with
        (* Warning: anyone using g thinks that an item has been read *)
        b.ind <- succ b.ind; Scons(r, d)
  | Slazy f -> get_data count (Lazy.force f)
-;;
+
 
 let rec peek_data : type v. v cell -> v option = fun s ->
  (* consult the first item of s *)
@@ -88,12 +88,12 @@ let rec peek_data : type v. v cell -> v option = fun s ->
      if b.ind >= b.len then fill_buff b;
      if b.len == 0 then begin s.data <- Sempty; None end
      else Some (Bytes.unsafe_get b.buff b.ind)
-;;
+
 
 let peek = function
   | None -> None
   | Some s -> peek_data s
-;;
+
 
 let rec junk_data : type v. v cell -> unit = fun s ->
   match s.data with
@@ -104,7 +104,7 @@ let rec junk_data : type v. v cell -> unit = fun s ->
       match peek_data s with
         None -> ()
       | Some _ -> junk_data s
-;;
+
 
 let junk = function
   | None -> ()
@@ -118,14 +118,14 @@ let rec nget_data n s =
         junk_data s;
         let (al, d, k) = nget_data (pred n) s in a :: al, Scons (a, d), succ k
     | None -> [], s.data, 0
-;;
+
 
 let npeek_data n s =
   let (al, d, len) = nget_data n s in
   s.count <- (s.count - len);
   s.data <- d;
   al
-;;
+
 
 let npeek n = function
   | None -> []
@@ -135,13 +135,13 @@ let next s =
   match peek s with
     Some a -> junk s; a
   | None -> raise Failure
-;;
+
 
 let empty s =
   match peek s with
     Some _ -> raise Failure
   | None -> ()
-;;
+
 
 let iter f strm =
   let rec do_rec () =
@@ -150,15 +150,15 @@ let iter f strm =
     | None -> ()
   in
   do_rec ()
-;;
+
 
 (* Stream building functions *)
 
-let from f = Some {count = 0; data = Sgen {curr = None; func = f}};;
+let from f = Some {count = 0; data = Sgen {curr = None; func = f}}
 
 let of_list l =
   Some {count = 0; data = List.fold_right (fun x l -> Scons (x, l)) l Sempty}
-;;
+
 
 let of_string s =
   let count = ref 0 in
@@ -173,7 +173,7 @@ let of_string s =
     if c < String.length s
     then (incr count; Some s.[c])
     else None)
-;;
+
 
 let of_bytes s =
   let count = ref 0 in
@@ -182,27 +182,27 @@ let of_bytes s =
     if c < Bytes.length s
     then (incr count; Some (Bytes.get s c))
     else None)
-;;
+
 
 let of_channel ic =
   Some {count = 0;
         data = Sbuffio {ic = ic; buff = Bytes.create 4096; len = 0; ind = 0}}
-;;
+
 
 (* Stream expressions builders *)
 
-let iapp i s = Some {count = 0; data = Sapp (data i, data s)};;
+let iapp i s = Some {count = 0; data = Sapp (data i, data s)}
-let icons i s = Some {count = 0; data = Scons (i, data s)};;
+let icons i s = Some {count = 0; data = Scons (i, data s)}
-let ising i = Some {count = 0; data = Scons (i, Sempty)};;
+let ising i = Some {count = 0; data = Scons (i, Sempty)}
 
 let lapp f s =
   Some {count = 0; data = Slazy (lazy(Sapp (data (f ()), data s)))}
-;;
-let lcons f s = Some {count = 0; data = Slazy (lazy(Scons (f (), data s)))};;
-let lsing f = Some {count = 0; data = Slazy (lazy(Scons (f (), Sempty)))};;
 
-let sempty = None;;
+let lcons f s = Some {count = 0; data = Slazy (lazy(Scons (f (), data s)))}
-let slazy f = Some {count = 0; data = Slazy (lazy(data (f ())))};;
+let lsing f = Some {count = 0; data = Slazy (lazy(Scons (f (), Sempty)))}
+
+let sempty = None
+let slazy f = Some {count = 0; data = Slazy (lazy(data (f ())))}
 
 (* For debugging use *)
 
@@ -231,4 +231,3 @@ and dump_data : type v. (v -> unit) -> v data -> unit = fun f ->
   | Slazy _ -> print_string "Slazy"
   | Sgen _ -> print_string "Sgen"
   | Sbuffio _ -> print_string "Sbuffio"
-;;

stdlib/sys.mlp

@@ -38,7 +38,7 @@ let unix = unix ()
 let win32 = win32 ()
 let cygwin = cygwin ()
 let max_array_length = max_wosize ()
-let max_string_length = word_size / 8 * max_array_length - 1;;
+let max_string_length = word_size / 8 * max_array_length - 1
 external runtime_variant : unit -> string = "caml_runtime_variant"
 external runtime_parameters : unit -> string = "caml_runtime_parameters"
 
@@ -111,7 +111,7 @@ external runtime_warnings_enabled: unit -> bool =
 
 (* The version string is found in file ../VERSION *)
 
-let ocaml_version = "%%VERSION%%";;
+let ocaml_version = "%%VERSION%%"
 
 (* Optimization *)
 

stdlib/weak.ml

@@ -15,20 +15,20 @@
 
 (** Weak array operations *)
 
-type 'a t;;
+type 'a t
 
-external create : int -> 'a t = "caml_weak_create";;
+external create : int -> 'a t = "caml_weak_create"
 
 (** number of additional values in a weak pointer *)
 let additional_values = 2
 
-let length x = Obj.size(Obj.repr x) - additional_values;;
+let length x = Obj.size(Obj.repr x) - additional_values
 
-external set : 'a t -> int -> 'a option -> unit = "caml_weak_set";;
+external set : 'a t -> int -> 'a option -> unit = "caml_weak_set"
-external get : 'a t -> int -> 'a option = "caml_weak_get";;
+external get : 'a t -> int -> 'a option = "caml_weak_get"
-external get_copy : 'a t -> int -> 'a option = "caml_weak_get_copy";;
+external get_copy : 'a t -> int -> 'a option = "caml_weak_get_copy"
-external check : 'a t -> int -> bool = "caml_weak_check";;
+external check : 'a t -> int -> bool = "caml_weak_check"
-external blit : 'a t -> int -> 'a t -> int -> int -> unit = "caml_weak_blit";;
+external blit : 'a t -> int -> 'a t -> int -> int -> unit = "caml_weak_blit"
 (* blit: src srcoff dst dstoff len *)
 
 let fill ar ofs len x =
@@ -39,7 +39,7 @@ let fill ar ofs len x =
       set ar i x
     done
   end
-;;
+
 
 (** Weak hash tables *)
 
@@ -58,15 +58,15 @@ module type S = sig
   val fold : (data -> 'a -> 'a) -> t -> 'a -> 'a
   val count : t -> int
   val stats : t -> int * int * int * int * int * int
-end;;
+end
 
 module Make (H : Hashtbl.HashedType) : (S with type data = H.t) = struct
 
-  type 'a weak_t = 'a t;;
+  type 'a weak_t = 'a t
-  let weak_create = create;;
+  let weak_create = create
-  let emptybucket = weak_create 0;;
+  let emptybucket = weak_create 0
 
-  type data = H.t;;
+  type data = H.t
 
   type t = {
     mutable table : data weak_t array;
@@ -74,12 +74,12 @@ module Make (H : Hashtbl.HashedType) : (S with type data = H.t) = struct
     mutable limit : int;               (* bucket size limit *)
     mutable oversize : int;            (* number of oversize buckets *)
     mutable rover : int;               (* for internal bookkeeping *)
-  };;
+  }
 
-  let get_index t h = (h land max_int) mod (Array.length t.table);;
+  let get_index t h = (h land max_int) mod (Array.length t.table)
 
-  let limit = 7;;
+  let limit = 7
-  let over_limit = 2;;
+  let over_limit = 2
 
   let create sz =
     let sz = if sz < 7 then 7 else sz in
@@ -90,7 +90,7 @@ module Make (H : Hashtbl.HashedType) : (S with type data = H.t) = struct
       limit = limit;
       oversize = 0;
       rover = 0;
-    };;
+    }
 
   let clear t =
     for i = 0 to Array.length t.table - 1 do
@@ -98,8 +98,8 @@ module Make (H : Hashtbl.HashedType) : (S with type data = H.t) = struct
       t.hashes.(i) <- [| |];
     done;
     t.limit <- limit;
-    t.oversize <- 0;
+    t.oversize <- 0
-  ;;
+
 
   let fold f t init =
     let rec fold_bucket i b accu =
@@ -109,7 +109,7 @@ module Make (H : Hashtbl.HashedType) : (S with type data = H.t) = struct
       | None -> fold_bucket (i+1) b accu
     in
     Array.fold_right (fold_bucket 0) t.table init
-  ;;
+
 
   let iter f t =
     let rec iter_bucket i b =
@@ -119,7 +119,7 @@ module Make (H : Hashtbl.HashedType) : (S with type data = H.t) = struct
       | None -> iter_bucket (i+1) b
     in
     Array.iter (iter_bucket 0) t.table
-  ;;
+
 
   let iter_weak f t =
     let rec iter_bucket i j b =
@@ -129,19 +129,19 @@ module Make (H : Hashtbl.HashedType) : (S with type data = H.t) = struct
       | false -> iter_bucket (i+1) j b
     in
     Array.iteri (iter_bucket 0) t.table
-  ;;
+
 
   let rec count_bucket i b accu =
     if i >= length b then accu else
     count_bucket (i+1) b (accu + (if check b i then 1 else 0))
-  ;;
+
 
   let count t =
     Array.fold_right (count_bucket 0) t.table 0
-  ;;
 
-  let next_sz n = min (3 * n / 2 + 3) Sys.max_array_length;;
+
-  let prev_sz n = ((n - 3) * 2 + 2) / 3;;
+  let next_sz n = min (3 * n / 2 + 3) Sys.max_array_length
+  let prev_sz n = ((n - 3) * 2 + 2) / 3
 
   let test_shrink_bucket t =
     let bucket = t.table.(t.rover) in
@@ -170,8 +170,8 @@ module Make (H : Hashtbl.HashedType) : (S with type data = H.t) = struct
       end;
       if len > t.limit && prev_len <= t.limit then t.oversize <- t.oversize - 1;
     end;
-    t.rover <- (t.rover + 1) mod (Array.length t.table);
+    t.rover <- (t.rover + 1) mod (Array.length t.table)
-  ;;
+
 
   let rec resize t =
     let oldlen = Array.length t.table in
@@ -222,13 +222,13 @@ module Make (H : Hashtbl.HashedType) : (S with type data = H.t) = struct
         hashes.(i) <- h;
       end;
     in
-    loop 0;
+    loop 0
-  ;;
+
 
   let add t d =
     let h = H.hash d in
-    add_aux t set (Some d) h (get_index t h);
+    add_aux t set (Some d) h (get_index t h)
-  ;;
+
 
   let find_or t d ifnotfound =
     let h = H.hash d in
@@ -249,13 +249,14 @@ module Make (H : Hashtbl.HashedType) : (S with type data = H.t) = struct
       end else loop (i + 1)
     in
     loop 0
-  ;;
+
 
   let merge t d =
     find_or t d (fun h index -> add_aux t set (Some d) h index; d)
-  ;;
 
-  let find t d = find_or t d (fun _h _index -> raise Not_found);;
+
+  let find t d = find_or t d (fun _h _index -> raise Not_found)
+
 
   let find_shadow t d iffound ifnotfound =
     let h = H.hash d in
@@ -272,11 +273,13 @@ module Make (H : Hashtbl.HashedType) : (S with type data = H.t) = struct
       end else loop (i + 1)
     in
     loop 0
-  ;;
 
-  let remove t d = find_shadow t d (fun w i -> set w i None) ();;
 
-  let mem t d = find_shadow t d (fun _w _i -> true) false;;
+  let remove t d = find_shadow t d (fun w i -> set w i None) ()
+
+
+  let mem t d = find_shadow t d (fun _w _i -> true) false
+
 
   let find_all t d =
     let h = H.hash d in
@@ -297,7 +300,7 @@ module Make (H : Hashtbl.HashedType) : (S with type data = H.t) = struct
       end else loop (i + 1) accu
     in
     loop 0 []
-  ;;
+
 
   let stats t =
     let len = Array.length t.table in
@@ -305,6 +308,6 @@ module Make (H : Hashtbl.HashedType) : (S with type data = H.t) = struct
     Array.sort compare lens;
     let totlen = Array.fold_left ( + ) 0 lens in
     (len, count t, totlen, lens.(0), lens.(len/2), lens.(len-1))
-  ;;
 
-end;;
+
+end

testsuite/tests/asmcomp/Makefile

@@ -47,9 +47,9 @@ parsecmm.mli parsecmm.ml: parsecmm.mly
 lexcmm.ml: lexcmm.mll
 	@$(OCAMLLEX) -q lexcmm.mll
 
-MLCASES=optargs staticalloc bind_tuples is_static
+MLCASES=optargs staticalloc bind_tuples is_static register_typing
 ARGS_is_static=-I $(OTOPDIR)/byterun is_in_static_data.c
-MLCASES_FLAMBDA=is_static_flambda
+MLCASES_FLAMBDA=is_static_flambda unrolling_flambda
 ARGS_is_static_flambda=-I $(OTOPDIR)/byterun is_in_static_data.c
 
 CASES=fib tak quicksort quicksort2 soli \

testsuite/tests/asmcomp/register_typing.ml

@@ -0,0 +1,20 @@
+type 'a typ = Int : int typ | Ptr : int list typ
+
+let f (type a) (t : a typ) (p : int list) : a =
+  match t with
+  | Int -> 100
+  | Ptr -> p
+
+let allocate_garbage () =
+  for i = 0 to 100 do
+    ignore (Array.make 200 0.0)
+  done
+
+let g (t : int list typ) x =
+  Gc.minor ();
+  let x = f t ([x; x; x; x; x]) in
+  Gc.minor ();
+  allocate_garbage ();
+  ignore (String.length (String.concat " " (List.map string_of_int x)))
+
+let () = g Ptr 5

testsuite/tests/asmcomp/unrolling_flambda.ml

@@ -0,0 +1,7 @@
+
+let rec f x =
+  if x > 0 then f (x - 1)
+  else 0
+[@@inline]
+
+let _ = f 0

testsuite/tests/link-test/Makefile

@@ -0,0 +1,36 @@
+#**************************************************************************
+#*                                                                        *
+#*                                OCaml                                   *
+#*                                                                        *
+#*                     Thomas Refis, Jane Street Europe                   *
+#*                                                                        *
+#*   Copyright 2010 Institut National de Recherche en Informatique et     *
+#*     en Automatique.                                                    *
+#*   Copyright 2016 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.          *
+#*                                                                        *
+#**************************************************************************
+
+default:
+	printf " ... testing 'test.reference':"
+	@$(OCAMLOPT) -c submodule.ml
+	@$(OCAMLOPT) -c aliases.ml
+	@$(OCAMLOPT) -c test.ml
+	@$(OCAMLOPT) -a submodule.cmx aliases.cmx -o mylib.cmxa
+	@$(OCAMLOPT) mylib.cmxa test.cmx -o test.native
+	@./test.native > test.result
+	@$(DIFF) test.result test.reference >/dev/null \
+	    && echo " => passed" || echo " => failed"
+
+promote: defaultpromote
+
+clean: defaultclean
+	@rm -f *.result
+	@rm -f test.native
+
+BASEDIR=../..
+include $(BASEDIR)/makefiles/Makefile.common
+COMPFLAGS = -no-alias-deps

testsuite/tests/link-test/aliases.ml

@@ -0,0 +1 @@
+module Submodule = Submodule

testsuite/tests/link-test/submodule.ml

@@ -0,0 +1,2 @@
+let () = print_endline "linked"; flush stdout
+module M = struct end

testsuite/tests/link-test/test.ml

@@ -0,0 +1 @@
+include Aliases.Submodule.M

testsuite/tests/link-test/test.reference

@@ -0,0 +1 @@
+linked

testsuite/tests/translprim/comparison_table.ml.reference

@@ -1,364 +1,381 @@
 (setglobal Comparison_table!
-  (let
+  (seq (opaque (global List!))
-    (gen_cmp = (function x y (caml_compare x y))
+    (let
-     int_cmp = (function x y (caml_int_compare x y))
+      (gen_cmp = (function x y (caml_compare x y))
-     bool_cmp =
+       int_cmp =
-       (function x y (caml_int_compare x y))
+         (function x y (caml_int_compare x y))
-     intlike_cmp =
+       bool_cmp =
-       (function x y (caml_int_compare x y))
+         (function x y (caml_int_compare x y))
-     float_cmp =
+       intlike_cmp =
-       (function x y (caml_float_compare x y))
+         (function x y (caml_int_compare x y))
-     string_cmp =
+       float_cmp =
-       (function x y (caml_string_compare x y))
+         (function x y (caml_float_compare x y))
-     int32_cmp =
+       string_cmp =
-       (function x y (caml_int32_compare x y))
+         (function x y (caml_string_compare x y))
-     int64_cmp =
+       int32_cmp =
-       (function x y (caml_int64_compare x y))
+         (function x y (caml_int32_compare x y))
-     nativeint_cmp =
+       int64_cmp =
-       (function x y (caml_nativeint_compare x y))
+         (function x y (caml_int64_compare x y))
-     gen_eq = (function x y (caml_equal x y))
+       nativeint_cmp =
-     int_eq = (function x y (== x y))
+         (function x y (caml_nativeint_compare x y))
-     bool_eq = (function x y (== x y))
+       gen_eq = (function x y (caml_equal x y))
-     intlike_eq = (function x y (== x y))
+       int_eq = (function x y (== x y))
-     float_eq = (function x y (==. x y))
+       bool_eq = (function x y (== x y))
-     string_eq =
+       intlike_eq = (function x y (== x y))
-       (function x y (caml_string_equal x y))
+       float_eq = (function x y (==. x y))
-     int32_eq = (function x y (Int32.== x y))
+       string_eq =
-     int64_eq = (function x y (Int64.== x y))
+         (function x y (caml_string_equal x y))
-     nativeint_eq =
+       int32_eq = (function x y (Int32.== x y))
-       (function x y (Nativeint.== x y))
+       int64_eq = (function x y (Int64.== x y))
-     gen_ne = (function x y (caml_notequal x y))
+       nativeint_eq =
-     int_ne = (function x y (!= x y))
+         (function x y (Nativeint.== x y))
-     bool_ne = (function x y (!= x y))
+       gen_ne = (function x y (caml_notequal x y))
-     intlike_ne = (function x y (!= x y))
+       int_ne = (function x y (!= x y))
-     float_ne = (function x y (!=. x y))
+       bool_ne = (function x y (!= x y))
-     string_ne =
+       intlike_ne = (function x y (!= x y))
-       (function x y (caml_string_notequal x y))
+       float_ne = (function x y (!=. x y))
-     int32_ne = (function x y (Int32.!= x y))
+       string_ne =
-     int64_ne = (function x y (Int64.!= x y))
+         (function x y (caml_string_notequal x y))
-     nativeint_ne =
+       int32_ne = (function x y (Int32.!= x y))
-       (function x y (Nativeint.!= x y))
+       int64_ne = (function x y (Int64.!= x y))
-     gen_lt = (function x y (caml_lessthan x y))
+       nativeint_ne =
-     int_lt = (function x y (< x y))
+         (function x y (Nativeint.!= x y))
-     bool_lt = (function x y (< x y))
+       gen_lt = (function x y (caml_lessthan x y))
-     intlike_lt = (function x y (< x y))
+       int_lt = (function x y (< x y))
-     float_lt = (function x y (<. x y))
+       bool_lt = (function x y (< x y))
-     string_lt =
+       intlike_lt = (function x y (< x y))
-       (function x y (caml_string_lessthan x y))
+       float_lt = (function x y (<. x y))
-     int32_lt = (function x y (Int32.< x y))
+       string_lt =
-     int64_lt = (function x y (Int64.< x y))
+         (function x y (caml_string_lessthan x y))
-     nativeint_lt = (function x y (Nativeint.< x y))
+       int32_lt = (function x y (Int32.< x y))
-     gen_gt = (function x y (caml_greaterthan x y))
+       int64_lt = (function x y (Int64.< x y))
-     int_gt = (function x y (> x y))
+       nativeint_lt =
-     bool_gt = (function x y (> x y))
+         (function x y (Nativeint.< x y))
-     intlike_gt = (function x y (> x y))
+       gen_gt =
-     float_gt = (function x y (>. x y))
+         (function x y (caml_greaterthan x y))
-     string_gt =
+       int_gt = (function x y (> x y))
-       (function x y (caml_string_greaterthan x y))
+       bool_gt = (function x y (> x y))
-     int32_gt = (function x y (Int32.> x y))
+       intlike_gt = (function x y (> x y))
-     int64_gt = (function x y (Int64.> x y))
+       float_gt = (function x y (>. x y))
-     nativeint_gt = (function x y (Nativeint.> x y))
+       string_gt =
-     gen_le = (function x y (caml_lessequal x y))
+         (function x y (caml_string_greaterthan x y))
-     int_le = (function x y (<= x y))
+       int32_gt = (function x y (Int32.> x y))
-     bool_le = (function x y (<= x y))
+       int64_gt = (function x y (Int64.> x y))
-     intlike_le = (function x y (<= x y))
+       nativeint_gt =
-     float_le = (function x y (<=. x y))
+         (function x y (Nativeint.> x y))
-     string_le =
+       gen_le = (function x y (caml_lessequal x y))
-       (function x y (caml_string_lessequal x y))
+       int_le = (function x y (<= x y))
-     int32_le = (function x y (Int32.<= x y))
+       bool_le = (function x y (<= x y))
-     int64_le = (function x y (Int64.<= x y))
+       intlike_le = (function x y (<= x y))
-     nativeint_le =
+       float_le = (function x y (<=. x y))
-       (function x y (Nativeint.<= x y))
+       string_le =
-     gen_ge = (function x y (caml_greaterequal x y))
+         (function x y (caml_string_lessequal x y))
-     int_ge = (function x y (>= x y))
+       int32_le = (function x y (Int32.<= x y))
-     bool_ge = (function x y (>= x y))
+       int64_le = (function x y (Int64.<= x y))
-     intlike_ge = (function x y (>= x y))
+       nativeint_le =
-     float_ge = (function x y (>=. x y))
+         (function x y (Nativeint.<= x y))
-     string_ge =
+       gen_ge =
-       (function x y (caml_string_greaterequal x y))
+         (function x y (caml_greaterequal x y))
-     int32_ge = (function x y (Int32.>= x y))
+       int_ge = (function x y (>= x y))
-     int64_ge = (function x y (Int64.>= x y))
+       bool_ge = (function x y (>= x y))
-     nativeint_ge =
+       intlike_ge = (function x y (>= x y))
-       (function x y (Nativeint.>= x y))
+       float_ge = (function x y (>=. x y))
-     eta_gen_cmp =
+       string_ge =
-       (function prim prim (caml_compare prim prim))
+         (function x y (caml_string_greaterequal x y))
-     eta_int_cmp =
+       int32_ge = (function x y (Int32.>= x y))
-       (function prim prim (caml_int_compare prim prim))
+       int64_ge = (function x y (Int64.>= x y))
-     eta_bool_cmp =
+       nativeint_ge =
-       (function prim prim (caml_int_compare prim prim))
+         (function x y (Nativeint.>= x y))
-     eta_intlike_cmp =
+       eta_gen_cmp =
-       (function prim prim (caml_int_compare prim prim))
+         (function prim prim (caml_compare prim prim))
-     eta_float_cmp =
+       eta_int_cmp =
-       (function prim prim
+         (function prim prim
-         (caml_float_compare prim prim))
+           (caml_int_compare prim prim))
-     eta_string_cmp =
+       eta_bool_cmp =
-       (function prim prim
+         (function prim prim
-         (caml_string_compare prim prim))
+           (caml_int_compare prim prim))
-     eta_int32_cmp =
+       eta_intlike_cmp =
-       (function prim prim
+         (function prim prim
-         (caml_int32_compare prim prim))
+           (caml_int_compare prim prim))
-     eta_int64_cmp =
+       eta_float_cmp =
-       (function prim prim
+         (function prim prim
-         (caml_int64_compare prim prim))
+           (caml_float_compare prim prim))
-     eta_nativeint_cmp =
+       eta_string_cmp =
-       (function prim prim
+         (function prim prim
-         (caml_nativeint_compare prim prim))
+           (caml_string_compare prim prim))
-     eta_gen_eq =
+       eta_int32_cmp =
-       (function prim prim (caml_equal prim prim))
+         (function prim prim
-     eta_int_eq =
+           (caml_int32_compare prim prim))
-       (function prim prim (== prim prim))
+       eta_int64_cmp =
-     eta_bool_eq =
+         (function prim prim
-       (function prim prim (== prim prim))
+           (caml_int64_compare prim prim))
-     eta_intlike_eq =
+       eta_nativeint_cmp =
-       (function prim prim (== prim prim))
+         (function prim prim
-     eta_float_eq =
+           (caml_nativeint_compare prim prim))
-       (function prim prim (==. prim prim))
+       eta_gen_eq =
-     eta_string_eq =
+         (function prim prim (caml_equal prim prim))
-       (function prim prim (caml_string_equal prim prim))
+       eta_int_eq =
-     eta_int32_eq =
+         (function prim prim (== prim prim))
-       (function prim prim (Int32.== prim prim))
+       eta_bool_eq =
-     eta_int64_eq =
+         (function prim prim (== prim prim))
-       (function prim prim (Int64.== prim prim))
+       eta_intlike_eq =
-     eta_nativeint_eq =
+         (function prim prim (== prim prim))
-       (function prim prim (Nativeint.== prim prim))
+       eta_float_eq =
-     eta_gen_ne =
+         (function prim prim (==. prim prim))
-       (function prim prim (caml_notequal prim prim))
+       eta_string_eq =
-     eta_int_ne =
+         (function prim prim
-       (function prim prim (!= prim prim))
+           (caml_string_equal prim prim))
-     eta_bool_ne =
+       eta_int32_eq =
-       (function prim prim (!= prim prim))
+         (function prim prim (Int32.== prim prim))
-     eta_intlike_ne =
+       eta_int64_eq =
-       (function prim prim (!= prim prim))
+         (function prim prim (Int64.== prim prim))
-     eta_float_ne =
+       eta_nativeint_eq =
-       (function prim prim (!=. prim prim))
+         (function prim prim (Nativeint.== prim prim))
-     eta_string_ne =
+       eta_gen_ne =
-       (function prim prim
+         (function prim prim (caml_notequal prim prim))
-         (caml_string_notequal prim prim))
+       eta_int_ne =
-     eta_int32_ne =
+         (function prim prim (!= prim prim))
-       (function prim prim (Int32.!= prim prim))
+       eta_bool_ne =
-     eta_int64_ne =
+         (function prim prim (!= prim prim))
-       (function prim prim (Int64.!= prim prim))
+       eta_intlike_ne =
-     eta_nativeint_ne =
+         (function prim prim (!= prim prim))
-       (function prim prim (Nativeint.!= prim prim))
+       eta_float_ne =
-     eta_gen_lt =
+         (function prim prim (!=. prim prim))
-       (function prim prim (caml_lessthan prim prim))
+       eta_string_ne =
-     eta_int_lt = (function prim prim (< prim prim))
+         (function prim prim
-     eta_bool_lt =
+           (caml_string_notequal prim prim))
-       (function prim prim (< prim prim))
+       eta_int32_ne =
-     eta_intlike_lt =
+         (function prim prim (Int32.!= prim prim))
-       (function prim prim (< prim prim))
+       eta_int64_ne =
-     eta_float_lt =
+         (function prim prim (Int64.!= prim prim))
-       (function prim prim (<. prim prim))
+       eta_nativeint_ne =
-     eta_string_lt =
+         (function prim prim (Nativeint.!= prim prim))
-       (function prim prim
+       eta_gen_lt =
-         (caml_string_lessthan prim prim))
+         (function prim prim (caml_lessthan prim prim))
-     eta_int32_lt =
+       eta_int_lt =
-       (function prim prim (Int32.< prim prim))
+         (function prim prim (< prim prim))
-     eta_int64_lt =
+       eta_bool_lt =
-       (function prim prim (Int64.< prim prim))
+         (function prim prim (< prim prim))
-     eta_nativeint_lt =
+       eta_intlike_lt =
-       (function prim prim (Nativeint.< prim prim))
+         (function prim prim (< prim prim))
-     eta_gen_gt =
+       eta_float_lt =
-       (function prim prim (caml_greaterthan prim prim))
+         (function prim prim (<. prim prim))
-     eta_int_gt = (function prim prim (> prim prim))
+       eta_string_lt =
-     eta_bool_gt =
+         (function prim prim
-       (function prim prim (> prim prim))
+           (caml_string_lessthan prim prim))
-     eta_intlike_gt =
+       eta_int32_lt =
-       (function prim prim (> prim prim))
+         (function prim prim (Int32.< prim prim))
-     eta_float_gt =
+       eta_int64_lt =
-       (function prim prim (>. prim prim))
+         (function prim prim (Int64.< prim prim))
-     eta_string_gt =
+       eta_nativeint_lt =
-       (function prim prim
+         (function prim prim (Nativeint.< prim prim))
-         (caml_string_greaterthan prim prim))
+       eta_gen_gt =
-     eta_int32_gt =
+         (function prim prim
-       (function prim prim (Int32.> prim prim))
+           (caml_greaterthan prim prim))
-     eta_int64_gt =
+       eta_int_gt =
-       (function prim prim (Int64.> prim prim))
+         (function prim prim (> prim prim))
-     eta_nativeint_gt =
+       eta_bool_gt =
-       (function prim prim (Nativeint.> prim prim))
+         (function prim prim (> prim prim))
-     eta_gen_le =
+       eta_intlike_gt =
-       (function prim prim (caml_lessequal prim prim))
+         (function prim prim (> prim prim))
-     eta_int_le =
+       eta_float_gt =
-       (function prim prim (<= prim prim))
+         (function prim prim (>. prim prim))
-     eta_bool_le =
+       eta_string_gt =
-       (function prim prim (<= prim prim))
+         (function prim prim
-     eta_intlike_le =
+           (caml_string_greaterthan prim prim))
-       (function prim prim (<= prim prim))
+       eta_int32_gt =
-     eta_float_le =
+         (function prim prim (Int32.> prim prim))
-       (function prim prim (<=. prim prim))
+       eta_int64_gt =
-     eta_string_le =
+         (function prim prim (Int64.> prim prim))
-       (function prim prim
+       eta_nativeint_gt =
-         (caml_string_lessequal prim prim))
+         (function prim prim (Nativeint.> prim prim))
-     eta_int32_le =
+       eta_gen_le =
-       (function prim prim (Int32.<= prim prim))
+         (function prim prim (caml_lessequal prim prim))
-     eta_int64_le =
+       eta_int_le =
-       (function prim prim (Int64.<= prim prim))
+         (function prim prim (<= prim prim))
-     eta_nativeint_le =
+       eta_bool_le =
-       (function prim prim (Nativeint.<= prim prim))
+         (function prim prim (<= prim prim))
-     eta_gen_ge =
+       eta_intlike_le =
-       (function prim prim (caml_greaterequal prim prim))
+         (function prim prim (<= prim prim))
-     eta_int_ge =
+       eta_float_le =
-       (function prim prim (>= prim prim))
+         (function prim prim (<=. prim prim))
-     eta_bool_ge =
+       eta_string_le =
-       (function prim prim (>= prim prim))
+         (function prim prim
-     eta_intlike_ge =
+           (caml_string_lessequal prim prim))
-       (function prim prim (>= prim prim))
+       eta_int32_le =
-     eta_float_ge =
+         (function prim prim (Int32.<= prim prim))
-       (function prim prim (>=. prim prim))
+       eta_int64_le =
-     eta_string_ge =
+         (function prim prim (Int64.<= prim prim))
-       (function prim prim
+       eta_nativeint_le =
-         (caml_string_greaterequal prim prim))
+         (function prim prim (Nativeint.<= prim prim))
-     eta_int32_ge =
+       eta_gen_ge =
-       (function prim prim (Int32.>= prim prim))
+         (function prim prim
-     eta_int64_ge =
+           (caml_greaterequal prim prim))
-       (function prim prim (Int64.>= prim prim))
+       eta_int_ge =
-     eta_nativeint_ge =
+         (function prim prim (>= prim prim))
-       (function prim prim (Nativeint.>= prim prim))
+       eta_bool_ge =
-     int_vec = [0: [0: 1 1] [0: [0: 1 2] [0: [0: 2 1] 0a]]]
+         (function prim prim (>= prim prim))
-     bool_vec = [0: [0: 0a 0a] [0: [0: 0a 1a] [0: [0: 1a 0a] 0a]]]
+       eta_intlike_ge =
-     intlike_vec = [0: [0: 0a 0a] [0: [0: 0a 1a] [0: [0: 1a 0a] 0a]]]
+         (function prim prim (>= prim prim))
-     float_vec = [0: [0: 1. 1.] [0: [0: 1. 2.] [0: [0: 2. 1.] 0a]]]
+       eta_float_ge =
-     string_vec =
+         (function prim prim (>=. prim prim))
-       [0: [0: "1" "1"] [0: [0: "1" "2"] [0: [0: "2" "1"] 0a]]]
+       eta_string_ge =
-     int32_vec = [0: [0: 1l 1l] [0: [0: 1l 2l] [0: [0: 2l 1l] 0a]]]
+         (function prim prim
-     int64_vec = [0: [0: 1L 1L] [0: [0: 1L 2L] [0: [0: 2L 1L] 0a]]]
+           (caml_string_greaterequal prim prim))
-     nativeint_vec = [0: [0: 1n 1n] [0: [0: 1n 2n] [0: [0: 2n 1n] 0a]]]
+       eta_int32_ge =
-     test_vec =
+         (function prim prim (Int32.>= prim prim))
-       (function cmp eq ne lt gt le ge
+       eta_int64_ge =
-         vec
+         (function prim prim (Int64.>= prim prim))
-         (let
+       eta_nativeint_ge =
-           (uncurry =
+         (function prim prim (Nativeint.>= prim prim))
-              (function f param
+       int_vec = [0: [0: 1 1] [0: [0: 1 2] [0: [0: 2 1] 0a]]]
-                (apply f (field 0 param) (field 1 param)))
+       bool_vec = [0: [0: 0a 0a] [0: [0: 0a 1a] [0: [0: 1a 0a] 0a]]]
-            map =
+       intlike_vec = [0: [0: 0a 0a] [0: [0: 0a 1a] [0: [0: 1a 0a] 0a]]]
-              (function f l
+       float_vec = [0: [0: 1. 1.] [0: [0: 1. 2.] [0: [0: 2. 1.] 0a]]]
-                (apply (field 12 (global List!)) (apply uncurry f)
+       string_vec =
-                  l)))
+         [0: [0: "1" "1"] [0: [0: "1" "2"] [0: [0: "2" "1"] 0a]]]
-           (makeblock 0
+       int32_vec = [0: [0: 1l 1l] [0: [0: 1l 2l] [0: [0: 2l 1l] 0a]]]
-             (makeblock 0 (apply map gen_cmp vec)
+       int64_vec = [0: [0: 1L 1L] [0: [0: 1L 2L] [0: [0: 2L 1L] 0a]]]
-               (apply map cmp vec))
+       nativeint_vec =
-             (apply map
+         [0: [0: 1n 1n] [0: [0: 1n 2n] [0: [0: 2n 1n] 0a]]]
-               (function gen spec
+       test_vec =
-                 (makeblock 0 (apply map gen vec)
+         (function cmp eq ne lt gt le ge
-                   (apply map spec vec)))
+           vec
-               (makeblock 0 (makeblock 0 gen_eq eq)
+           (let
-                 (makeblock 0 (makeblock 0 gen_ne ne)
+             (uncurry =
-                   (makeblock 0 (makeblock 0 gen_lt lt)
+                (function f param
-                     (makeblock 0 (makeblock 0 gen_gt gt)
+                  (apply f (field 0 param) (field 1 param)))
-                       (makeblock 0 (makeblock 0 gen_le le)
+              map =
-                         (makeblock 0 (makeblock 0 gen_ge ge) 0a)))))))))))
+                (function f l
-    (seq
+                  (apply (field 12 (global List!))
-      (apply test_vec int_cmp int_eq int_ne int_lt
+                    (apply uncurry f) l)))
-        int_gt int_le int_ge int_vec)
+             (makeblock 0
-      (apply test_vec bool_cmp bool_eq bool_ne
+               (makeblock 0 (apply map gen_cmp vec)
-        bool_lt bool_gt bool_le bool_ge bool_vec)
+                 (apply map cmp vec))
-      (apply test_vec intlike_cmp intlike_eq intlike_ne
+               (apply map
-        intlike_lt intlike_gt intlike_le intlike_ge
+                 (function gen spec
-        intlike_vec)
+                   (makeblock 0 (apply map gen vec)
-      (apply test_vec float_cmp float_eq float_ne
+                     (apply map spec vec)))
-        float_lt float_gt float_le float_ge
+                 (makeblock 0 (makeblock 0 gen_eq eq)
-        float_vec)
+                   (makeblock 0 (makeblock 0 gen_ne ne)
-      (apply test_vec string_cmp string_eq string_ne
+                     (makeblock 0 (makeblock 0 gen_lt lt)
-        string_lt string_gt string_le string_ge
+                       (makeblock 0 (makeblock 0 gen_gt gt)
-        string_vec)
+                         (makeblock 0 (makeblock 0 gen_le le)
-      (apply test_vec int32_cmp int32_eq int32_ne
+                           (makeblock 0 (makeblock 0 gen_ge ge) 0a)))))))))))
-        int32_lt int32_gt int32_le int32_ge
+      (seq
-        int32_vec)
+        (apply test_vec int_cmp int_eq int_ne int_lt
-      (apply test_vec int64_cmp int64_eq int64_ne
+          int_gt int_le int_ge int_vec)
-        int64_lt int64_gt int64_le int64_ge
+        (apply test_vec bool_cmp bool_eq bool_ne
-        int64_vec)
+          bool_lt bool_gt bool_le bool_ge bool_vec)
-      (apply test_vec nativeint_cmp nativeint_eq
+        (apply test_vec intlike_cmp intlike_eq intlike_ne
-        nativeint_ne nativeint_lt nativeint_gt
+          intlike_lt intlike_gt intlike_le intlike_ge
-        nativeint_le nativeint_ge nativeint_vec)
+          intlike_vec)
-      (let
+        (apply test_vec float_cmp float_eq float_ne
-        (eta_test_vec =
+          float_lt float_gt float_le float_ge
-           (function cmp eq ne lt gt le ge
+          float_vec)
-             vec
+        (apply test_vec string_cmp string_eq string_ne
-             (let
+          string_lt string_gt string_le string_ge
-               (uncurry =
+          string_vec)
-                  (function f param
+        (apply test_vec int32_cmp int32_eq int32_ne
-                    (apply f (field 0 param) (field 1 param)))
+          int32_lt int32_gt int32_le int32_ge
-                map =
+          int32_vec)
-                  (function f l
+        (apply test_vec int64_cmp int64_eq int64_ne
-                    (apply (field 12 (global List!))
+          int64_lt int64_gt int64_le int64_ge
-                      (apply uncurry f) l)))
+          int64_vec)
-               (makeblock 0
+        (apply test_vec nativeint_cmp nativeint_eq
-                 (makeblock 0 (apply map eta_gen_cmp vec)
+          nativeint_ne nativeint_lt nativeint_gt
-                   (apply map cmp vec))
+          nativeint_le nativeint_ge nativeint_vec)
-                 (apply map
+        (let
-                   (function gen spec
+          (eta_test_vec =
-                     (makeblock 0 (apply map gen vec)
+             (function cmp eq ne lt gt le
-                       (apply map spec vec)))
+               ge vec
-                   (makeblock 0 (makeblock 0 eta_gen_eq eq)
+               (let
-                     (makeblock 0 (makeblock 0 eta_gen_ne ne)
+                 (uncurry =
-                       (makeblock 0 (makeblock 0 eta_gen_lt lt)
+                    (function f param
-                         (makeblock 0 (makeblock 0 eta_gen_gt gt)
+                      (apply f (field 0 param)
-                           (makeblock 0 (makeblock 0 eta_gen_le le)
+                        (field 1 param)))
+                  map =
+                    (function f l
+                      (apply (field 12 (global List!))
+                        (apply uncurry f) l)))
+                 (makeblock 0
+                   (makeblock 0 (apply map eta_gen_cmp vec)
+                     (apply map cmp vec))
+                   (apply map
+                     (function gen spec
+                       (makeblock 0 (apply map gen vec)
+                         (apply map spec vec)))
+                     (makeblock 0 (makeblock 0 eta_gen_eq eq)
+                       (makeblock 0 (makeblock 0 eta_gen_ne ne)
+                         (makeblock 0 (makeblock 0 eta_gen_lt lt)
+                           (makeblock 0 (makeblock 0 eta_gen_gt gt)
                              (makeblock 0
-                               (makeblock 0 eta_gen_ge ge) 0a)))))))))))
+                               (makeblock 0 eta_gen_le le)
-        (seq
+                               (makeblock 0
-          (apply eta_test_vec eta_int_cmp eta_int_eq
+                                 (makeblock 0 eta_gen_ge ge) 0a)))))))))))
-            eta_int_ne eta_int_lt eta_int_gt eta_int_le
+          (seq
-            eta_int_ge int_vec)
+            (apply eta_test_vec eta_int_cmp eta_int_eq
-          (apply eta_test_vec eta_bool_cmp eta_bool_eq
+              eta_int_ne eta_int_lt eta_int_gt eta_int_le
-            eta_bool_ne eta_bool_lt eta_bool_gt
+              eta_int_ge int_vec)
-            eta_bool_le eta_bool_ge bool_vec)
+            (apply eta_test_vec eta_bool_cmp eta_bool_eq
-          (apply eta_test_vec eta_intlike_cmp eta_intlike_eq
+              eta_bool_ne eta_bool_lt eta_bool_gt
-            eta_intlike_ne eta_intlike_lt eta_intlike_gt
+              eta_bool_le eta_bool_ge bool_vec)
-            eta_intlike_le eta_intlike_ge intlike_vec)
+            (apply eta_test_vec eta_intlike_cmp eta_intlike_eq
-          (apply eta_test_vec eta_float_cmp eta_float_eq
+              eta_intlike_ne eta_intlike_lt eta_intlike_gt
-            eta_float_ne eta_float_lt eta_float_gt
+              eta_intlike_le eta_intlike_ge intlike_vec)
-            eta_float_le eta_float_ge float_vec)
+            (apply eta_test_vec eta_float_cmp eta_float_eq
-          (apply eta_test_vec eta_string_cmp eta_string_eq
+              eta_float_ne eta_float_lt eta_float_gt
-            eta_string_ne eta_string_lt eta_string_gt
+              eta_float_le eta_float_ge float_vec)
-            eta_string_le eta_string_ge string_vec)
+            (apply eta_test_vec eta_string_cmp eta_string_eq
-          (apply eta_test_vec eta_int32_cmp eta_int32_eq
+              eta_string_ne eta_string_lt eta_string_gt
-            eta_int32_ne eta_int32_lt eta_int32_gt
+              eta_string_le eta_string_ge string_vec)
-            eta_int32_le eta_int32_ge int32_vec)
+            (apply eta_test_vec eta_int32_cmp eta_int32_eq
-          (apply eta_test_vec eta_int64_cmp eta_int64_eq
+              eta_int32_ne eta_int32_lt eta_int32_gt
-            eta_int64_ne eta_int64_lt eta_int64_gt
+              eta_int32_le eta_int32_ge int32_vec)
-            eta_int64_le eta_int64_ge int64_vec)
+            (apply eta_test_vec eta_int64_cmp eta_int64_eq
-          (apply eta_test_vec eta_nativeint_cmp
+              eta_int64_ne eta_int64_lt eta_int64_gt
-            eta_nativeint_eq eta_nativeint_ne eta_nativeint_lt
+              eta_int64_le eta_int64_ge int64_vec)
-            eta_nativeint_gt eta_nativeint_le eta_nativeint_ge
+            (apply eta_test_vec eta_nativeint_cmp
-            nativeint_vec)
+              eta_nativeint_eq eta_nativeint_ne
-          (makeblock 0 gen_cmp int_cmp bool_cmp
+              eta_nativeint_lt eta_nativeint_gt
-            intlike_cmp float_cmp string_cmp int32_cmp
+              eta_nativeint_le eta_nativeint_ge nativeint_vec)
-            int64_cmp nativeint_cmp gen_eq int_eq
+            (makeblock 0 gen_cmp int_cmp bool_cmp
-            bool_eq intlike_eq float_eq string_eq
+              intlike_cmp float_cmp string_cmp int32_cmp
-            int32_eq int64_eq nativeint_eq gen_ne
+              int64_cmp nativeint_cmp gen_eq int_eq
-            int_ne bool_ne intlike_ne float_ne
+              bool_eq intlike_eq float_eq string_eq
-            string_ne int32_ne int64_ne nativeint_ne
+              int32_eq int64_eq nativeint_eq gen_ne
-            gen_lt int_lt bool_lt intlike_lt
+              int_ne bool_ne intlike_ne float_ne
-            float_lt string_lt int32_lt int64_lt
+              string_ne int32_ne int64_ne nativeint_ne
-            nativeint_lt gen_gt int_gt bool_gt
+              gen_lt int_lt bool_lt intlike_lt
-            intlike_gt float_gt string_gt int32_gt
+              float_lt string_lt int32_lt int64_lt
-            int64_gt nativeint_gt gen_le int_le
+              nativeint_lt gen_gt int_gt bool_gt
-            bool_le intlike_le float_le string_le
+              intlike_gt float_gt string_gt int32_gt
-            int32_le int64_le nativeint_le gen_ge
+              int64_gt nativeint_gt gen_le int_le
-            int_ge bool_ge intlike_ge float_ge
+              bool_le intlike_le float_le string_le
-            string_ge int32_ge int64_ge nativeint_ge
+              int32_le int64_le nativeint_le gen_ge
-            eta_gen_cmp eta_int_cmp eta_bool_cmp
+              int_ge bool_ge intlike_ge float_ge
-            eta_intlike_cmp eta_float_cmp eta_string_cmp
+              string_ge int32_ge int64_ge nativeint_ge
-            eta_int32_cmp eta_int64_cmp eta_nativeint_cmp
+              eta_gen_cmp eta_int_cmp eta_bool_cmp
-            eta_gen_eq eta_int_eq eta_bool_eq
+              eta_intlike_cmp eta_float_cmp eta_string_cmp
-            eta_intlike_eq eta_float_eq eta_string_eq
+              eta_int32_cmp eta_int64_cmp eta_nativeint_cmp
-            eta_int32_eq eta_int64_eq eta_nativeint_eq
+              eta_gen_eq eta_int_eq eta_bool_eq
-            eta_gen_ne eta_int_ne eta_bool_ne
+              eta_intlike_eq eta_float_eq eta_string_eq
-            eta_intlike_ne eta_float_ne eta_string_ne
+              eta_int32_eq eta_int64_eq eta_nativeint_eq
-            eta_int32_ne eta_int64_ne eta_nativeint_ne
+              eta_gen_ne eta_int_ne eta_bool_ne
-            eta_gen_lt eta_int_lt eta_bool_lt
+              eta_intlike_ne eta_float_ne eta_string_ne
-            eta_intlike_lt eta_float_lt eta_string_lt
+              eta_int32_ne eta_int64_ne eta_nativeint_ne
-            eta_int32_lt eta_int64_lt eta_nativeint_lt
+              eta_gen_lt eta_int_lt eta_bool_lt
-            eta_gen_gt eta_int_gt eta_bool_gt
+              eta_intlike_lt eta_float_lt eta_string_lt
-            eta_intlike_gt eta_float_gt eta_string_gt
+              eta_int32_lt eta_int64_lt eta_nativeint_lt
-            eta_int32_gt eta_int64_gt eta_nativeint_gt
+              eta_gen_gt eta_int_gt eta_bool_gt
-            eta_gen_le eta_int_le eta_bool_le
+              eta_intlike_gt eta_float_gt eta_string_gt
-            eta_intlike_le eta_float_le eta_string_le
+              eta_int32_gt eta_int64_gt eta_nativeint_gt
-            eta_int32_le eta_int64_le eta_nativeint_le
+              eta_gen_le eta_int_le eta_bool_le
-            eta_gen_ge eta_int_ge eta_bool_ge
+              eta_intlike_le eta_float_le eta_string_le
-            eta_intlike_ge eta_float_ge eta_string_ge
+              eta_int32_le eta_int64_le eta_nativeint_le
-            eta_int32_ge eta_int64_ge eta_nativeint_ge
+              eta_gen_ge eta_int_ge eta_bool_ge
-            int_vec bool_vec intlike_vec float_vec
+              eta_intlike_ge eta_float_ge eta_string_ge
-            string_vec int32_vec int64_vec nativeint_vec
+              eta_int32_ge eta_int64_ge eta_nativeint_ge
-            test_vec eta_test_vec))))))
+              int_vec bool_vec intlike_vec float_vec
+              string_vec int32_vec int64_vec
+              nativeint_vec test_vec eta_test_vec)))))))

testsuite/tests/typing-modules/pr7207.ml

@@ -0,0 +1,2 @@
+module F (X : sig end) = struct type t = int end;;
+type t = F(Does_not_exist).t;;

testsuite/tests/typing-modules/pr7207.ml.reference

@@ -0,0 +1,7 @@
+
+# module F : functor (X : sig  end) -> sig type t = int end
+# Characters 9-28:
+  type t = F(Does_not_exist).t;;
+           ^^^^^^^^^^^^^^^^^^^
+Error: Unbound module Does_not_exist
+# 

testsuite/tests/typing-polyvariants-bugs/pr7199_ok.ml

@@ -0,0 +1,13 @@
+module type S = sig
+ type +'a t
+
+ val foo : [`A] t -> unit
+ val bar : [< `A | `B] t -> unit
+end
+
+module Make(T : S) = struct
+ let f x =
+   T.foo x;
+   T.bar x;
+   (x :> [`A | `C] T.t)
+end

tools/Makefile.shared

@@ -51,9 +51,9 @@ CAMLDEP_IMPORTS=timings.cmo misc.cmo config.cmo identifiable.cmo numbers.cmo \
   arg_helper.cmo clflags.cmo terminfo.cmo \
   warnings.cmo location.cmo longident.cmo docstrings.cmo \
   syntaxerr.cmo ast_helper.cmo parser.cmo lexer.cmo parse.cmo \
-  ccomp.cmo ast_mapper.cmo ast_iterator.cmo ast_invariants.cmo pparse.cmo \
+  ccomp.cmo ast_mapper.cmo ast_iterator.cmo \
-  compenv.cmo \
+  builtin_attributes.cmo ast_invariants.cmo \
-  builtin_attributes.cmo depend.cmo
+  pparse.cmo compenv.cmo depend.cmo
 
 ocamldep: $(CAMLDEP_OBJ)
 	$(CAMLC) $(LINKFLAGS) -compat-32 -o ocamldep $(CAMLDEP_IMPORTS) \

tools/make-package-macosx

@@ -88,7 +88,8 @@ mkdir -p resources
 cat >resources/ReadMe.txt <<EOF
 This package installs OCaml version ${VERSION}.
 You need Mac OS X 10.11.x (El Capitan) or later, with the
-XCode tools installed (v7.2.1 or later).
+XCode tools installed (v7.3 or later) and the command-line
+tools for XCode.
 
 Files will be installed in the following directories:
 

typing/printtyp.ml

@@ -1431,11 +1431,11 @@ let explanation unif t3 t4 ppf =
         row1.row_fields, row1.row_closed, row2.row_fields, row2.row_closed with
       | [], true, [], true ->
           fprintf ppf "@,These two variant types have no intersection"
-      | [], true, fields, _ ->
+      | [], true, (_::_ as fields), _ ->
           fprintf ppf
             "@,@[The first variant type does not allow tag(s)@ @[<hov>%a@]@]"
             print_tags fields
-      | fields, _, [], true ->
+      | (_::_ as fields), _, [], true ->
           fprintf ppf
             "@,@[The second variant type does not allow tag(s)@ @[<hov>%a@]@]"
             print_tags fields

typing/typecore.ml

@@ -1945,7 +1945,7 @@ and type_expect_ ?in_function ?(recarg=Rejected) env sexp ty_expected =
         | false, Rejected, _
           -> ()
         | true, Rejected, _
-        | false, Required, Tvar _ ->
+        | false, Required, (Tvar _ | Tconstr _) ->
             raise (Error (loc, env, Inlined_record_escape))
         | false, Required, _  ->
             () (* will fail later *)
@@ -2424,8 +2424,9 @@ and type_expect_ ?in_function ?(recarg=Rejected) env sexp ty_expected =
           (Texp_constraint cty, loc, sexp.pexp_attributes) :: arg.exp_extra;
       }
   | Pexp_coerce(sarg, sty, sty') ->
-      (* Could be always true, only 1% slowdown for lablgtk *)
+      let separate = true in (* always separate, 1% slowdown for lablgtk *)
-      let separate = !Clflags.principal || Env.has_local_constraints env in
+      (* Also see PR#7199 for a problem with the following:
+         let separate = !Clflags.principal || Env.has_local_constraints env in*)
       let (arg, ty',cty,cty') =
         match sty with
         | None ->

typing/typetexp.ml

@@ -101,8 +101,8 @@ let rec narrow_unbound_lid_error : 'a. _ -> _ -> _ -> _ -> 'a =
           raise (Error (loc, env, Cannot_scrape_alias(flid, p)))
       | _ -> ()
       end;
-      let mmd = Env.find_module (Env.lookup_module ~load:true mlid env) env in
       check_module mlid;
+      let mmd = Env.find_module (Env.lookup_module ~load:true mlid env) env in
       begin match Env.scrape_alias env mmd.md_type with
       | Mty_alias p ->
           raise (Error (loc, env, Cannot_scrape_alias(mlid, p)))