Synchronize with trunk.unused_declarations

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

184 files changed, 3192 insertions, 1396 deletions

diff --git a/.depend b/.depend
index 5ab125bf02..ee61e2f7d3 100644
--- a/.depend
+++ b/.depend
@@ -122,18 +122,16 @@ typing/datarepr.cmo: typing/types.cmi typing/predef.cmi utils/misc.cmi \
     typing/btype.cmi parsing/asttypes.cmi typing/datarepr.cmi
 typing/datarepr.cmx: typing/types.cmx typing/predef.cmx utils/misc.cmx \
     typing/btype.cmx parsing/asttypes.cmi typing/datarepr.cmi
-typing/env.cmo: utils/warnings.cmi typing/types.cmi utils/tbl.cmi \
-    typing/subst.cmi typing/predef.cmi typing/path.cmi utils/misc.cmi \
-    parsing/longident.cmi parsing/location.cmi typing/ident.cmi \
-    typing/datarepr.cmi utils/consistbl.cmi utils/config.cmi \
-    utils/clflags.cmi typing/btype.cmi parsing/asttypes.cmi typing/annot.cmi \
-    typing/env.cmi
-typing/env.cmx: utils/warnings.cmx typing/types.cmx utils/tbl.cmx \
-    typing/subst.cmx typing/predef.cmx typing/path.cmx utils/misc.cmx \
-    parsing/longident.cmx parsing/location.cmx typing/ident.cmx \
-    typing/datarepr.cmx utils/consistbl.cmx utils/config.cmx \
-    utils/clflags.cmx typing/btype.cmx parsing/asttypes.cmi typing/annot.cmi \
-    typing/env.cmi
+typing/env.cmo: typing/types.cmi utils/tbl.cmi typing/subst.cmi \
+    typing/predef.cmi typing/path.cmi utils/misc.cmi parsing/longident.cmi \
+    parsing/location.cmi typing/ident.cmi typing/datarepr.cmi \
+    utils/consistbl.cmi utils/config.cmi utils/clflags.cmi typing/btype.cmi \
+    parsing/asttypes.cmi typing/annot.cmi typing/env.cmi
+typing/env.cmx: typing/types.cmx utils/tbl.cmx typing/subst.cmx \
+    typing/predef.cmx typing/path.cmx utils/misc.cmx parsing/longident.cmx \
+    parsing/location.cmx typing/ident.cmx typing/datarepr.cmx \
+    utils/consistbl.cmx utils/config.cmx utils/clflags.cmx typing/btype.cmx \
+    parsing/asttypes.cmi typing/annot.cmi typing/env.cmi
 typing/ident.cmo: typing/ident.cmi
 typing/ident.cmx: typing/ident.cmi
 typing/includeclass.cmo: typing/types.cmi typing/printtyp.cmi \
@@ -339,13 +337,15 @@ bytecomp/bytelibrarian.cmo: utils/misc.cmi utils/config.cmi \
 bytecomp/bytelibrarian.cmx: utils/misc.cmx utils/config.cmx \
     bytecomp/cmo_format.cmi utils/clflags.cmx bytecomp/bytelink.cmx \
     bytecomp/bytelibrarian.cmi
-bytecomp/bytelink.cmo: bytecomp/symtable.cmi bytecomp/opcodes.cmo \
-    utils/misc.cmi bytecomp/instruct.cmi typing/ident.cmi bytecomp/dll.cmi \
+bytecomp/bytelink.cmo: utils/warnings.cmi bytecomp/symtable.cmi \
+    bytecomp/opcodes.cmo utils/misc.cmi parsing/location.cmi \
+    bytecomp/instruct.cmi typing/ident.cmi bytecomp/dll.cmi \
     utils/consistbl.cmi utils/config.cmi bytecomp/cmo_format.cmi \
     utils/clflags.cmi utils/ccomp.cmi bytecomp/bytesections.cmi \
     bytecomp/bytelink.cmi
-bytecomp/bytelink.cmx: bytecomp/symtable.cmx bytecomp/opcodes.cmx \
-    utils/misc.cmx bytecomp/instruct.cmx typing/ident.cmx bytecomp/dll.cmx \
+bytecomp/bytelink.cmx: utils/warnings.cmx bytecomp/symtable.cmx \
+    bytecomp/opcodes.cmx utils/misc.cmx parsing/location.cmx \
+    bytecomp/instruct.cmx typing/ident.cmx bytecomp/dll.cmx \
     utils/consistbl.cmx utils/config.cmx bytecomp/cmo_format.cmi \
     utils/clflags.cmx utils/ccomp.cmx bytecomp/bytesections.cmx \
     bytecomp/bytelink.cmi
diff --git a/Changes b/Changes
index 06aaf54e05..27905bf150 100644
--- a/Changes
+++ b/Changes
@@ -12,43 +12,70 @@ Language features:
   Using the -principal option guarantees forward compatibility.
 - New (module M) and (module M : S) syntax in patterns, for immediate
   unpacking of a first-class module.
-- New syntax "let.e0 p = e1 in e2" where e0 is a simple expression,
-  expanded to "e0 e1 (fun p -> e2).
 
 Compilers:
 - Revised simplification of let-alias (PR#5205, PR#5288)
 - Better reporting of compiler version mismatch in .cmi files
-- Warning 28 is now enabled by default.
+* Warning 28 is now enabled by default.
 - New option -absname to use absolute paths in error messages
 
 Native-code compiler:
 - Optimized handling of partially-applied functions (PR#5287)
+- Small improvements in code generated for array bounds checks (PR#5345,
+  PR#5360).
 
 Standard library:
 - Added float functions "hypot" and "copysign" (PR#3806, PR#4752, PR#5246)
-- Hashtbl:
+* Arg: options with empty doc strings are no longer included in the usage string
+  (PR#5437)
+- Array: faster implementations of "blit", "copy", "sub", "append" and "concat"
+  (PR#2395, PR#2787, PR#4591)
+* Hashtbl:
     . Statistically-better generic hash function based on Murmur 3 (PR#5225)
     . Fixed behavior of generic hash function w.r.t. -0.0 and NaN (PR#5222)
     . Added optional "seed" parameter to Hashtbl.create for diversification
     . Added new functorial interface "MakeSeeded" to support diversification
       with user-provided hash functions.
+- Scanf: new function "unescaped" (PR#3888)
+- Set and Map: more efficient implementation of "filter" and "partition"
+- String: new function "map" (PR#3888)
 
 Bug Fixes:
-- PR#5416: (Windows) Unix.(set|clear)_close_on_exec now preserves blocking mode
-- PR#5343: ocaml -rectypes is unsound wrt module subtyping
+* PR#4549: Filename.dirname is not handling multiple / on Unix
+- PR#4869: rare collisions between assembly labels for code and data
+- PR#4880: "assert" constructs now show up in the exception stack backtrace
+- PR#5313: ocamlopt -g misses optimizations
 - PR#5322: type abbreviations expanding to a universal type variable
+- PR#5325: (Windows) blocked Unix.recv in one thread blocks Unix.send in
+  another thread
+- PR#5327: (Windows) Unix.select blocks if same socket listed in first and third arguments
 - PR#5330: thread tag with '.top' and '.inferred.mli' targets
-- PR#4880: "assert" constructs now show up in the exception stack backtrace
-- PR#4869: rare collisions between assembly labels for code and data
+- PR#5343: ocaml -rectypes is unsound wrt module subtyping
+- PR#5416: (Windows) Unix.(set|clear)_close_on_exec now preserves blocking mode
+- PR#5436: update object ids on unmarshaling
+- PR#5453: configure doesn't find X11 under Ubuntu/MultiarchSpec
+- PR#5469: private record type generated by functor loses abbreviation
+- PR#5476: bug in native code compilation of let rec on float arrays
+- PR#4688: (Windows) special floating-point values aren't converted to strings correctly
+- emacs mode: colorization of comments and strings now works correctly
+- PR5475: Wrapper script for interpreted LablTk wrongly handles command line parameters
+- PR5461: Double linking of bytecode modules
 
 Feature wishes:
-- PR#5358: first class modules don't allow "with type" declarations for types in sub-modules
+- PR#352: new option "-stdin" to make ocaml read stdin as a script
+- PR#5329: (Windows) more efficient Unix.select if all fd's are sockets
+- PR#5358: first class modules don't allow "with type" declarations for types
+  in sub-modules
 - PR#5411: new directive for the toplevel: #load_rec
 - PR#5420: Unix.openfile share mode (Windows)
+- PR#5454: Digest.compare is missing and md5 doc update
+- PR#5467: no extern "C" into ocaml C-stub headers
+- PR#5478: ocamlopt assumes ar command exists
+- PR5479: Num.num_of_string may raise an exception, not reflected in the documentation.
 
 Shedding weight:
-- Removed the obsolete native-code generators for Alpha, HPPA, IA64 and MIPS.
-- The "DBM" library (interface with Unix DBM key-value stores) is no
+* Removed the obsolete native-code generators for Alpha, HPPA, IA64 and MIPS.
+* The "DBM" library (interface with Unix DBM key-value stores) is no
   longer part of this distribution.  It now lives its own life at
   https://forge.ocamlcore.org/projects/camldbm/
 
@@ -228,7 +255,7 @@ Compilers and toplevel:
   caused by the incomplete comparison of applicative paths F(X).t.
 
 Native-code compiler:
-- AMD64: shorter and slightly more efficient code generated for 
+- AMD64: shorter and slightly more efficient code generated for
   float comparisons.
 
 Standard library:
diff --git a/Makefile b/Makefile
index a8f442e520..6cde4d5b45 100644
--- a/Makefile
+++ b/Makefile
@@ -383,6 +383,7 @@ utils/config.ml: utils/config.mlp config/Makefile
 	    -e 's|%%BYTECCLIBS%%|$(BYTECCLIBS)|' \
 	    -e 's|%%NATIVECCLIBS%%|$(NATIVECCLIBS)|' \
 	    -e 's|%%RANLIBCMD%%|$(RANLIBCMD)|' \
+	    -e 's|%%ARCMD%%|$(ARCMD)|' \
 	    -e 's|%%CC_PROFILE%%|$(CC_PROFILE)|' \
 	    -e 's|%%ARCH%%|$(ARCH)|' \
 	    -e 's|%%MODEL%%|$(MODEL)|' \
diff --git a/Makefile.nt b/Makefile.nt
index 69b8d6a4d6..a7d6aedb9c 100644
--- a/Makefile.nt
+++ b/Makefile.nt
@@ -323,6 +323,7 @@ utils/config.ml: utils/config.mlp config/Makefile
 	    -e "s|%%BYTECCLIBS%%|$(BYTECCLIBS)|" \
 	    -e "s|%%NATIVECCLIBS%%|$(NATIVECCLIBS)|" \
 	    -e 's|%%RANLIBCMD%%|$(RANLIBCMD)|' \
+	    -e 's|%%ARCMD%%|$(ARCMD)|' \
 	    -e 's|%%BINUTILS_NM%%|$(BINUTILS_NM)|' \
 	    -e 's|%%BINUTILS_OBJCOPY%%|$(BINUTILS_OBJCOPY)|' \
 	    -e "s|%%ARCH%%|$(ARCH)|" \
diff --git a/VERSION b/VERSION
index fe54d2adb4..efa00e6815 100644
--- a/VERSION
+++ b/VERSION
@@ -1,4 +1,4 @@
-3.13.0+dev8 (2011-10-25)
+3.13.0+dev10 (2012-01-10)
 
 # The version string is the first line of this file.
 # It must be in the format described in stdlib/sys.mli
diff --git a/asmcomp/amd64/emit.mlp b/asmcomp/amd64/emit.mlp
index 1c4a59ce10..097c6cd2e2 100644
--- a/asmcomp/amd64/emit.mlp
+++ b/asmcomp/amd64/emit.mlp
@@ -23,11 +23,8 @@ open Mach
 open Linearize
 open Emitaux
 
-let macosx =
-  match Config.system with
-  | "macosx" -> true
-  | _ -> false
-
+let macosx = (Config.system = "macosx")
+let mingw64 = (Config.system = "mingw64")
 
 (* Tradeoff between code size and code speed *)
 
@@ -64,17 +61,17 @@ let emit_symbol s =
     Emitaux.emit_symbol '$' s
 
 let emit_call s =
-  if !Clflags.dlcode && not macosx
+  if !Clflags.dlcode && not macosx && not mingw64
   then `call	{emit_symbol s}@PLT`
   else `call	{emit_symbol s}`
 
 let emit_jump s =
-  if !Clflags.dlcode && not macosx
+  if !Clflags.dlcode && not macosx && not mingw64
   then `jmp	{emit_symbol s}@PLT`
   else `jmp	{emit_symbol s}`
 
 let load_symbol_addr s =
-  if !Clflags.dlcode
+  if !Clflags.dlcode && not mingw64
   then `movq	{emit_symbol s}@GOTPCREL(%rip)`
   else if !pic_code
   then `leaq	{emit_symbol s}(%rip)`
@@ -604,9 +601,12 @@ let emit_instr fallthrough i =
         `	movslq	({emit_reg tmp1}, {emit_reg i.arg.(0)}, 4), {emit_reg tmp2}\n`;
         `	addq	{emit_reg tmp2}, {emit_reg tmp1}\n`;
         `	jmp	*{emit_reg tmp1}\n`;
-        if macosx
-        then `	.const\n`
-        else `	.section .rodata\n`;
+        if macosx then
+          `	.const\n`
+        else if mingw64 then
+          `	.section .rdata,\"dr\"\n`
+        else
+          `	.section .rodata\n`;
         emit_align 4;
         `{emit_label lbl}:`;
         for i = 0 to Array.length jumptbl - 1 do
@@ -701,9 +701,12 @@ let fundecl fundecl =
     | _ -> ()
   end;
   if !float_constants <> [] then begin
-    if macosx
-    then `	.literal8\n`
-    else `	.section	.rodata.cst8,\"a\",@progbits\n`;
+    if macosx then
+      `	.literal8\n`
+    else if mingw64 then
+      `	.section .rdata,\"dr\"\n`
+    else
+      `	.section .rodata.cst8,\"a\",@progbits\n`;
     List.iter emit_float_constant !float_constants
   end
 
@@ -749,9 +752,11 @@ let begin_assembly() =
   if !Clflags.dlcode then begin
     (* from amd64.S; could emit these constants on demand *)
     if macosx then
-        `	.literal16\n`
+      `	.literal16\n`
+    else if mingw64 then
+      `	.section .rdata,\"dr\"\n`
     else
-        `	.section        .rodata.cst8,\"a\",@progbits\n`;
+      `	.section .rodata.cst8,\"a\",@progbits\n`;
     emit_align 16;
     `{emit_symbol "caml_negf_mask"}:	.quad   0x8000000000000000, 0\n`;
     emit_align 16;
diff --git a/asmcomp/cmmgen.ml b/asmcomp/cmmgen.ml
index 61fef31b80..7a7bd211ad 100644
--- a/asmcomp/cmmgen.ml
+++ b/asmcomp/cmmgen.ml
@@ -369,6 +369,14 @@ let make_float_alloc tag args =
   make_alloc_generic float_array_set tag
                      (List.length args * size_float / size_addr) args
 
+(* Bounds checking *)
+
+let make_checkbound dbg = function
+  | [Cop(Clsr, [a1; Cconst_int n]); Cconst_int m] when (m lsl n) > n ->
+      Cop(Ccheckbound dbg, [a1; Cconst_int(m lsl n + 1 lsl n - 1)])
+  | args ->
+      Cop(Ccheckbound dbg, args)
+
 (* To compile "let rec" over values *)
 
 let fundecls_size fundecls =
@@ -381,6 +389,7 @@ let fundecls_size fundecls =
 
 type rhs_kind =
   | RHS_block of int
+  | RHS_floatblock of int
   | RHS_nonrec
 ;;
 let rec expr_size = function
@@ -394,6 +403,8 @@ let rec expr_size = function
       RHS_block (List.length args)
   | Uprim(Pmakearray(Paddrarray | Pintarray), args, _) ->
       RHS_block (List.length args)
+  | Uprim(Pmakearray(Pfloatarray), args, _) ->
+      RHS_floatblock (List.length args)
   | Usequence(exp, exp') ->
       expr_size exp'
   | _ -> RHS_nonrec
@@ -534,7 +545,7 @@ let bigarray_elt_size = function
 
 let bigarray_indexing unsafe elt_kind layout b args dbg =
   let check_bound a1 a2 k =
-    if unsafe then k else Csequence(Cop(Ccheckbound dbg, [a1;a2]), k) in
+    if unsafe then k else Csequence(make_checkbound dbg [a1;a2], k) in
   let rec ba_indexing dim_ofs delta_ofs = function
     [] -> assert false
   | [arg] ->
@@ -1209,7 +1220,7 @@ and transl_prim_2 p arg1 arg2 dbg =
         (bind "str" (transl arg1) (fun str ->
           bind "index" (untag_int (transl arg2)) (fun idx ->
             Csequence(
-              Cop(Ccheckbound dbg, [string_length str; idx]),
+              make_checkbound dbg [string_length str; idx],
               Cop(Cload Byte_unsigned, [add_int str idx])))))
 
   (* Array operations *)
@@ -1228,26 +1239,31 @@ and transl_prim_2 p arg1 arg2 dbg =
       end
   | Parrayrefs kind ->
       begin match kind with
-        Pgenarray ->
+      | Pgenarray ->
           bind "index" (transl arg2) (fun idx ->
-            bind "arr" (transl arg1) (fun arr ->
-              bind "header" (header arr) (fun hdr ->
-                Cifthenelse(is_addr_array_hdr hdr,
-                  Csequence(Cop(Ccheckbound dbg, [addr_array_length hdr; idx]),
-                            addr_array_ref arr idx),
-                  Csequence(Cop(Ccheckbound dbg, [float_array_length hdr; idx]),
-                            float_array_ref arr idx)))))
+          bind "arr" (transl arg1) (fun arr ->
+          bind "header" (header arr) (fun hdr ->
+            if wordsize_shift = numfloat_shift then
+              Csequence(make_checkbound dbg [addr_array_length hdr; idx],
+                        Cifthenelse(is_addr_array_hdr hdr, 
+                                    addr_array_ref arr idx,
+                                    float_array_ref arr idx))
+            else
+              Cifthenelse(is_addr_array_hdr hdr,
+                Csequence(make_checkbound dbg [addr_array_length hdr; idx],
+                          addr_array_ref arr idx),
+                Csequence(make_checkbound dbg [float_array_length hdr; idx],
+                          float_array_ref arr idx)))))
       | Paddrarray | Pintarray ->
           bind "index" (transl arg2) (fun idx ->
             bind "arr" (transl arg1) (fun arr ->
-              Csequence(Cop(Ccheckbound dbg, [addr_array_length(header arr); idx]),
+              Csequence(make_checkbound dbg [addr_array_length(header arr); idx],
                         addr_array_ref arr idx)))
       | Pfloatarray ->
           box_float(
             bind "index" (transl arg2) (fun idx ->
               bind "arr" (transl arg1) (fun arr ->
-                Csequence(Cop(Ccheckbound dbg,
-                              [float_array_length(header arr); idx]),
+                Csequence(make_checkbound dbg [float_array_length(header arr); idx],
                           unboxed_float_array_ref arr idx))))
       end
 
@@ -1316,7 +1332,7 @@ and transl_prim_3 p arg1 arg2 arg3 dbg =
         (bind "str" (transl arg1) (fun str ->
           bind "index" (untag_int (transl arg2)) (fun idx ->
             Csequence(
-              Cop(Ccheckbound dbg, [string_length str; idx]),
+              make_checkbound dbg [string_length str; idx],
               Cop(Cstore Byte_unsigned,
                   [add_int str idx; untag_int(transl arg3)])))))
 
@@ -1339,31 +1355,38 @@ and transl_prim_3 p arg1 arg2 arg3 dbg =
       end)
   | Parraysets kind ->
       return_unit(begin match kind with
-        Pgenarray ->
+      | Pgenarray ->
           bind "newval" (transl arg3) (fun newval ->
-            bind "index" (transl arg2) (fun idx ->
-              bind "arr" (transl arg1) (fun arr ->
-                bind "header" (header arr) (fun hdr ->
-                  Cifthenelse(is_addr_array_hdr hdr,
-                    Csequence(Cop(Ccheckbound dbg, [addr_array_length hdr; idx]),
-                              addr_array_set arr idx newval),
-                    Csequence(Cop(Ccheckbound dbg, [float_array_length hdr; idx]),
-                              float_array_set arr idx
-                                              (unbox_float newval)))))))
+          bind "index" (transl arg2) (fun idx ->
+          bind "arr" (transl arg1) (fun arr ->
+          bind "header" (header arr) (fun hdr ->
+            if wordsize_shift = numfloat_shift then
+              Csequence(make_checkbound dbg [addr_array_length hdr; idx],
+                        Cifthenelse(is_addr_array_hdr hdr, 
+                                    addr_array_set arr idx newval,
+                                    float_array_set arr idx
+                                                    (unbox_float newval)))
+            else
+              Cifthenelse(is_addr_array_hdr hdr,
+                Csequence(make_checkbound dbg [addr_array_length hdr; idx],
+                          addr_array_set arr idx newval),
+                Csequence(make_checkbound dbg [float_array_length hdr; idx],
+                          float_array_set arr idx
+                                          (unbox_float newval)))))))
       | Paddrarray ->
           bind "index" (transl arg2) (fun idx ->
             bind "arr" (transl arg1) (fun arr ->
-              Csequence(Cop(Ccheckbound dbg, [addr_array_length(header arr); idx]),
+              Csequence(make_checkbound dbg [addr_array_length(header arr); idx],
                         addr_array_set arr idx (transl arg3))))
       | Pintarray ->
           bind "index" (transl arg2) (fun idx ->
             bind "arr" (transl arg1) (fun arr ->
-              Csequence(Cop(Ccheckbound dbg, [addr_array_length(header arr); idx]),
+              Csequence(make_checkbound dbg [addr_array_length(header arr); idx],
                         int_array_set arr idx (transl arg3))))
       | Pfloatarray ->
           bind "index" (transl arg2) (fun idx ->
             bind "arr" (transl arg1) (fun arr ->
-              Csequence(Cop(Ccheckbound dbg, [float_array_length(header arr);idx]),
+              Csequence(make_checkbound dbg [float_array_length(header arr);idx],
                         float_array_set arr idx (transl_unbox_float arg3))))
       end)
   | _ ->
@@ -1504,25 +1527,29 @@ and transl_switch arg index cases = match Array.length cases with
 
 and transl_letrec bindings cont =
   let bsz = List.map (fun (id, exp) -> (id, exp, expr_size exp)) bindings in
+  let op_alloc prim sz =
+    Cop(Cextcall(prim, typ_addr, true, Debuginfo.none), [int_const sz]) in
   let rec init_blocks = function
     | [] -> fill_nonrec bsz
     | (id, exp, RHS_block sz) :: rem ->
-        Clet(id, Cop(Cextcall("caml_alloc_dummy", typ_addr, true, Debuginfo.none),
-                     [int_const sz]),
-             init_blocks rem)
+        Clet(id, op_alloc "caml_alloc_dummy" sz, init_blocks rem)
+    | (id, exp, RHS_floatblock sz) :: rem ->
+        Clet(id, op_alloc "caml_alloc_dummy_float" sz, init_blocks rem)
     | (id, exp, RHS_nonrec) :: rem ->
         Clet (id, Cconst_int 0, init_blocks rem)
   and fill_nonrec = function
     | [] -> fill_blocks bsz
-    | (id, exp, RHS_block sz) :: rem -> fill_nonrec rem
+    | (id, exp, (RHS_block _ | RHS_floatblock _)) :: rem ->
+        fill_nonrec rem
     | (id, exp, RHS_nonrec) :: rem ->
         Clet (id, transl exp, fill_nonrec rem)
   and fill_blocks = function
     | [] -> cont
-    | (id, exp, RHS_block _) :: rem ->
-        Csequence(Cop(Cextcall("caml_update_dummy", typ_void, false, Debuginfo.none),
-                      [Cvar id; transl exp]),
-                  fill_blocks rem)
+    | (id, exp, (RHS_block _ | RHS_floatblock _)) :: rem ->
+        let op =
+          Cop(Cextcall("caml_update_dummy", typ_void, false, Debuginfo.none),
+              [Cvar id; transl exp]) in
+        Csequence(op, fill_blocks rem)
     | (id, exp, RHS_nonrec) :: rem ->
         fill_blocks rem
   in init_blocks bsz
diff --git a/asmrun/Makefile.nt b/asmrun/Makefile.nt
index 67f94d6587..81e2890143 100644
--- a/asmrun/Makefile.nt
+++ b/asmrun/Makefile.nt
@@ -54,6 +54,9 @@ amd64nt.obj: amd64nt.asm
 i386.o: i386.S
 	$(CC) -c -DSYS_$(SYSTEM) i386.S
 
+amd64.o: amd64.S
+	$(CC) -c -DSYS_$(SYSTEM) amd64.S
+
 install:
 	cp libasmrun.$(A) $(LIBDIR)
 
diff --git a/asmrun/amd64.S b/asmrun/amd64.S
index ff031dd5f6..791b2f411f 100644
--- a/asmrun/amd64.S
+++ b/asmrun/amd64.S
@@ -18,7 +18,7 @@
 
 /* PIC mode support based on contribution by Paul Stravers (see PR#4795) */
 
-#ifdef SYS_macosx
+#if defined(SYS_macosx)
 
 #define LBL(x) L##x	
 #define G(r) _##r
@@ -32,6 +32,20 @@
         .align FUNCTION_ALIGN; \
         name:
 
+#elif defined(SYS_mingw64)
+	
+#define LBL(x) .L##x	
+#define G(r) r
+#undef  GREL
+#define GCALL(r) r
+#define FUNCTION_ALIGN 4
+#define EIGHT_ALIGN 8
+#define SIXTEEN_ALIGN 16
+#define FUNCTION(name) \
+        .globl name; \
+        .align FUNCTION_ALIGN; \
+        name:
+
 #else
 
 #define LBL(x) .L##x	
@@ -49,7 +63,7 @@
 
 #endif
 
-#ifdef __PIC__
+#if defined(__PIC__) && !defined(SYS_mingw64)
 
 /* Position-independent operations on global variables. */
 
@@ -122,6 +136,88 @@
 
 #endif
 
+/* Save and restore all callee-save registers on stack.  
+   Keep the stack 16-aligned. */
+
+#if defined(SYS_mingw64)	
+
+/* Win64 API: callee-save regs are rbx, rbp, rsi, rdi, r12-r15, xmm6-xmm15 */
+
+#define PUSH_CALLEE_SAVE_REGS \
+        pushq   %rbx; \
+        pushq   %rbp; \
+        pushq   %rsi; \
+        pushq   %rdi; \
+        pushq   %r12; \
+        pushq   %r13; \
+        pushq   %r14; \
+        pushq   %r15; \
+	subq	$(8+10*16), %rsp; \
+	movupd  %xmm6, 0*16(%rsp); \
+        movupd  %xmm7, 1*16(%rsp); \
+        movupd  %xmm8, 2*16(%rsp); \
+        movupd  %xmm9, 3*16(%rsp); \
+        movupd  %xmm10, 4*16(%rsp); \
+        movupd  %xmm11, 5*16(%rsp); \
+        movupd  %xmm12, 6*16(%rsp); \
+        movupd  %xmm13, 7*16(%rsp); \
+        movupd  %xmm14, 8*16(%rsp); \
+        movupd  %xmm15, 9*16(%rsp)
+
+#define POP_CALLEE_SAVE_REGS \
+        movupd  0*16(%rsp), %xmm6; \
+        movupd  1*16(%rsp), %xmm7; \
+        movupd  2*16(%rsp), %xmm8; \
+        movupd  3*16(%rsp), %xmm9; \
+        movupd  4*16(%rsp), %xmm10; \
+        movupd  5*16(%rsp), %xmm11; \
+        movupd  6*16(%rsp), %xmm12; \
+        movupd  7*16(%rsp), %xmm13; \
+        movupd  8*16(%rsp), %xmm14; \
+        movupd  9*16(%rsp), %xmm15; \
+        addq    $(8+10*16), %rsp; \
+        popq    %r15; \
+        popq    %r14; \
+        popq    %r13; \
+        popq    %r12; \
+        popq    %rdi; \
+        popq    %rsi; \
+        popq    %rbp; \
+        popq    %rbx
+
+#else
+
+/* Unix API: callee-save regs are rbx, rbp, r12-r15 */
+
+#define PUSH_CALLEE_SAVE_REGS \
+        pushq   %rbx; \
+        pushq   %rbp; \
+        pushq   %r12; \
+        pushq   %r13; \
+        pushq   %r14; \
+        pushq   %r15; \
+	subq	$8, %rsp
+
+#define POP_CALLEE_SAVE_REGS \
+	addq	$8, %rsp; \
+        popq    %r15; \
+        popq    %r14; \
+        popq    %r13; \
+        popq    %r12; \
+        popq    %rbp; \
+        popq    %rbx
+
+#endif	
+
+#ifdef SYS_mingw64
+   /* Calls from Caml to C must reserve 32 bytes of extra stack space */
+#  define PREPARE_FOR_C_CALL subq $32, %rsp	
+#  define CLEANUP_AFTER_C_CALL addq $32, %rsp
+#else
+#  define PREPARE_FOR_C_CALL
+#  define CLEANUP_AFTER_C_CALL
+#endif
+
         .text
 
 /* Allocation */
@@ -166,7 +262,9 @@ LBL(caml_call_gc):
         movsd   %xmm14, 14*8(%rsp)
         movsd   %xmm15, 15*8(%rsp)
     /* Call the garbage collector */
+	PREPARE_FOR_C_CALL
         call    GCALL(caml_garbage_collection)
+	CLEANUP_AFTER_C_CALL
     /* Restore caml_young_ptr, caml_exception_pointer */
 	LOAD_VAR(caml_young_ptr, %r15)
 	LOAD_VAR(caml_exception_pointer, %r14)
@@ -269,6 +367,8 @@ LBL(caml_c_call):
 	STORE_VAR(%r15, caml_young_ptr)
 	STORE_VAR(%r14, caml_exception_pointer)
     /* Call the function (address in %rax) */
+    /* No need to PREPARE_FOR_C_CALL since the caller already
+       reserved the stack space if needed (cf. amd64/proc.ml) */
         call    *%rax
     /* Reload alloc ptr */
 	LOAD_VAR(caml_young_ptr, %r15)
@@ -280,13 +380,7 @@ LBL(caml_c_call):
 
 FUNCTION(G(caml_start_program))
     /* Save callee-save registers */
-        pushq   %rbx
-        pushq   %rbp
-        pushq   %r12
-        pushq   %r13
-        pushq   %r14
-        pushq   %r15
-	subq	$8, %rsp	/* stack 16-aligned */
+        PUSH_CALLEE_SAVE_REGS
     /* Initial entry point is G(caml_program) */
         leaq    GCALL(caml_program)(%rip), %r12
     /* Common code for caml_start_program and caml_callback* */
@@ -320,13 +414,7 @@ LBL(109):
         POP_VAR(caml_gc_regs)
 	addq	$8, %rsp
     /* Restore callee-save registers. */
-	addq	$8, %rsp
-        popq    %r15
-        popq    %r14
-        popq    %r13
-        popq    %r12
-        popq    %rbp
-        popq    %rbx
+        POP_CALLEE_SAVE_REGS
     /* Return to caller. */
         ret
 LBL(108):
@@ -335,6 +423,20 @@ LBL(108):
         orq     $2, %rax
         jmp     LBL(109)
 
+/* Registers holding arguments of C functions. */
+
+#ifdef SYS_mingw64
+#define C_ARG_1 %rcx
+#define C_ARG_2 %rdx
+#define C_ARG_3 %r8
+#define C_ARG_4 %r9
+#else
+#define C_ARG_1 %rdi
+#define C_ARG_2 %rsi
+#define C_ARG_3 %rdx
+#define C_ARG_4 %rcx
+#endif
+
 /* Raise an exception from Caml */
 
 FUNCTION(G(caml_raise_exn))
@@ -345,10 +447,11 @@ FUNCTION(G(caml_raise_exn))
         ret
 LBL(110):
         movq    %rax, %r12            /* Save exception bucket */
-        movq    %rax, %rdi            /* arg 1: exception bucket */
-        movq    0(%rsp), %rsi         /* arg 2: pc of raise */
-        leaq    8(%rsp), %rdx         /* arg 3: sp of raise */
-        movq    %r14, %rcx            /* arg 4: sp of handler */
+        movq    %rax, C_ARG_1         /* arg 1: exception bucket */
+        movq    0(%rsp), C_ARG_2      /* arg 2: pc of raise */
+        leaq    8(%rsp), C_ARG_3      /* arg 3: sp of raise */
+        movq    %r14, C_ARG_4         /* arg 4: sp of handler */
+	PREPARE_FOR_C_CALL            /* no need to cleanup after */
         call    GCALL(caml_stash_backtrace)
         movq    %r12, %rax            /* Recover exception bucket */
         movq    %r14, %rsp
@@ -360,17 +463,18 @@ LBL(110):
 FUNCTION(G(caml_raise_exception))
         TESTL_VAR($1, caml_backtrace_active)
         jne     LBL(111)
-        movq    %rdi, %rax
+        movq    C_ARG_1, %rax
         LOAD_VAR(caml_exception_pointer, %rsp)  /* Cut stack */
         popq    %r14                  /* Recover previous exception handler */
         LOAD_VAR(caml_young_ptr, %r15) /* Reload alloc ptr */
         ret
 LBL(111):
-        movq    %rdi, %r12            /* Save exception bucket */
+        movq    C_ARG_1, %r12            /* Save exception bucket */
                                       /* arg 1: exception bucket */
-	LOAD_VAR(caml_last_return_address,%rsi)   /* arg 2: pc of raise */
-        LOAD_VAR(caml_bottom_of_stack,%rdx)       /* arg 3: sp of raise */
-        LOAD_VAR(caml_exception_pointer,%rcx)     /* arg 4: sp of handler */
+	LOAD_VAR(caml_last_return_address,C_ARG_2)   /* arg 2: pc of raise */
+        LOAD_VAR(caml_bottom_of_stack,C_ARG_3)       /* arg 3: sp of raise */
+        LOAD_VAR(caml_exception_pointer,C_ARG_4)     /* arg 4: sp of handler */
+	PREPARE_FOR_C_CALL            /* no need to cleanup after */
         call    GCALL(caml_stash_backtrace)
         movq    %r12, %rax            /* Recover exception bucket */
 	LOAD_VAR(caml_exception_pointer,%rsp)
@@ -382,49 +486,31 @@ LBL(111):
 
 FUNCTION(G(caml_callback_exn))
     /* Save callee-save registers */
-        pushq   %rbx
-        pushq   %rbp
-        pushq   %r12
-        pushq   %r13
-        pushq   %r14
-        pushq   %r15
-	subq	$8, %rsp	/* stack 16-aligned */
+        PUSH_CALLEE_SAVE_REGS
     /* Initial loading of arguments */
-        movq    %rdi, %rbx      /* closure */
-        movq    %rsi, %rax      /* argument */
-        movq    0(%rbx), %r12   /* code pointer */
+        movq    C_ARG_1, %rbx      /* closure */
+        movq    C_ARG_2, %rax      /* argument */
+        movq    0(%rbx), %r12      /* code pointer */
         jmp     LBL(caml_start_program)
 
 FUNCTION(G(caml_callback2_exn))
     /* Save callee-save registers */
-        pushq   %rbx
-        pushq   %rbp
-        pushq   %r12
-        pushq   %r13
-        pushq   %r14
-        pushq   %r15
-	subq	$8, %rsp	/* stack 16-aligned */
+        PUSH_CALLEE_SAVE_REGS
     /* Initial loading of arguments */
-        /* closure stays in %rdi */
-        movq    %rsi, %rax               /* first argument */
-        movq    %rdx, %rbx               /* second argument */
+        movq    C_ARG_1, %rdi      /* closure -- no op with Unix conventions */
+        movq    C_ARG_2, %rax      /* first argument */
+        movq    C_ARG_3, %rbx      /* second argument */
         leaq    GCALL(caml_apply2)(%rip), %r12  /* code pointer */
         jmp     LBL(caml_start_program)
 
 FUNCTION(G(caml_callback3_exn))
     /* Save callee-save registers */
-        pushq   %rbx
-        pushq   %rbp
-        pushq   %r12
-        pushq   %r13
-        pushq   %r14
-        pushq   %r15
-	subq	$8, %rsp	/* stack 16-aligned */
+        PUSH_CALLEE_SAVE_REGS
     /* Initial loading of arguments */
-        movq    %rsi, %rax               /* first argument */
-        movq    %rdx, %rbx               /* second argument */
-        movq    %rdi, %rsi               /* closure */
-        movq    %rcx, %rdi               /* third argument */
+        movq    C_ARG_2, %rax      /* first argument */
+        movq    C_ARG_3, %rbx      /* second argument */
+        movq    C_ARG_1, %rsi      /* closure */
+        movq    C_ARG_4, %rdi      /* third argument */
         leaq    GCALL(caml_apply3)(%rip), %r12  /* code pointer */
         jmp     LBL(caml_start_program)
 
@@ -442,8 +528,10 @@ G(caml_system__frametable):
         .value  0           /* no roots here */
         .align  EIGHT_ALIGN
 
-#ifdef SYS_macosx
+#if defined(SYS_macosx)
 	.literal16
+#elif defined(SYS_mingw64)
+	.section .rdata,"dr"
 #else
 	.section    .rodata.cst8,"a",@progbits
 #endif
diff --git a/boot/ocamlc b/boot/ocamlc
index 8dd2669683..52bf472686 100755
--- a/boot/ocamlc
+++ b/boot/ocamlc
diff --git a/boot/ocamldep b/boot/ocamldep
index 12edd51e42..ac8687a783 100755
--- a/boot/ocamldep
+++ b/boot/ocamldep
diff --git a/boot/ocamllex b/boot/ocamllex
index dd2b5bce35..633bf7095a 100755
--- a/boot/ocamllex
+++ b/boot/ocamllex
diff --git a/bytecomp/bytelibrarian.ml b/bytecomp/bytelibrarian.ml
index 62d900023d..767a3dca68 100644
--- a/bytecomp/bytelibrarian.ml
+++ b/bytecomp/bytelibrarian.ml
@@ -55,7 +55,7 @@ let add_ccobjs l =
     lib_dllibs := !lib_dllibs @ l.lib_dllibs
   end
 
-let copy_object_file oc name =
+let copy_object_file ppf oc name =
   let file_name =
     try
       find_in_path !load_path name
@@ -69,7 +69,7 @@ let copy_object_file oc name =
       let compunit_pos = input_binary_int ic in
       seek_in ic compunit_pos;
       let compunit = (input_value ic : compilation_unit) in
-      Bytelink.check_consistency file_name compunit;
+      Bytelink.check_consistency ppf file_name compunit;
       copy_compunit ic oc compunit;
       close_in ic;
       [compunit]
@@ -78,7 +78,7 @@ let copy_object_file oc name =
       let toc_pos = input_binary_int ic in
       seek_in ic toc_pos;
       let toc = (input_value ic : library) in
-      List.iter (Bytelink.check_consistency file_name) toc.lib_units;
+      List.iter (Bytelink.check_consistency ppf file_name) toc.lib_units;
       add_ccobjs toc;
       List.iter (copy_compunit ic oc) toc.lib_units;
       close_in ic;
@@ -89,13 +89,13 @@ let copy_object_file oc name =
     End_of_file -> close_in ic; raise(Error(Not_an_object_file file_name))
   | x -> close_in ic; raise x
 
-let create_archive file_list lib_name =
+let create_archive ppf file_list lib_name =
   let outchan = open_out_bin lib_name in
   try
     output_string outchan cma_magic_number;
     let ofs_pos_toc = pos_out outchan in
     output_binary_int outchan 0;
-    let units = List.flatten(List.map (copy_object_file outchan) file_list) in
+    let units = List.flatten(List.map (copy_object_file ppf outchan) file_list) in
     let toc =
       { lib_units = units;
         lib_custom = !Clflags.custom_runtime;
diff --git a/bytecomp/bytelibrarian.mli b/bytecomp/bytelibrarian.mli
index a4250f96d7..2420111593 100644
--- a/bytecomp/bytelibrarian.mli
+++ b/bytecomp/bytelibrarian.mli
@@ -21,7 +21,7 @@
       content table = list of compilation units
 *)
 
-val create_archive: string list -> string -> unit
+val create_archive: Format.formatter -> string list -> string -> unit
 
 type error =
     File_not_found of string
diff --git a/bytecomp/bytelink.ml b/bytecomp/bytelink.ml
index 794a0acb4a..aa4c3d45a4 100644
--- a/bytecomp/bytelink.ml
+++ b/bytecomp/bytelink.ml
@@ -29,6 +29,7 @@ type error =
   | File_exists of string
   | Cannot_open_dll of string
 
+
 exception Error of error
 
 type link_action =
@@ -161,9 +162,10 @@ let scan_file obj_name tolink =
 (* Consistency check between interfaces *)
 
 let crc_interfaces = Consistbl.create ()
+let implementations_defined = ref ([] : (string * string) list)
 
-let check_consistency file_name cu =
-  try
+let check_consistency ppf file_name cu =
+  begin try
     List.iter
       (fun (name, crc) ->
         if name = cu.cu_name
@@ -172,6 +174,15 @@ let check_consistency file_name cu =
       cu.cu_imports
   with Consistbl.Inconsistency(name, user, auth) ->
     raise(Error(Inconsistent_import(name, user, auth)))
+  end;
+  begin try
+    let source = List.assoc cu.cu_name !implementations_defined in
+    Location.print_warning (Location.in_file file_name) ppf
+      (Warnings.Multiple_definition(cu.cu_name, file_name, source))
+  with Not_found -> ()
+  end;
+  implementations_defined :=
+    (cu.cu_name, file_name) :: !implementations_defined
 
 let extract_crc_interfaces () =
   Consistbl.extract crc_interfaces
@@ -182,8 +193,8 @@ let debug_info = ref ([] : (int * string) list)
 
 (* Link in a compilation unit *)
 
-let link_compunit output_fun currpos_fun inchan file_name compunit =
-  check_consistency file_name compunit;
+let link_compunit ppf output_fun currpos_fun inchan file_name compunit =
+  check_consistency ppf file_name compunit;
   seek_in inchan compunit.cu_pos;
   let code_block = String.create compunit.cu_codesize in
   really_input inchan code_block 0 compunit.cu_codesize;
@@ -200,10 +211,10 @@ let link_compunit output_fun currpos_fun inchan file_name compunit =
 
 (* Link in a .cmo file *)
 
-let link_object output_fun currpos_fun file_name compunit =
+let link_object ppf output_fun currpos_fun file_name compunit =
   let inchan = open_in_bin file_name in
   try
-    link_compunit output_fun currpos_fun inchan file_name compunit;
+    link_compunit ppf output_fun currpos_fun inchan file_name compunit;
     close_in inchan
   with
     Symtable.Error msg ->
@@ -213,14 +224,14 @@ let link_object output_fun currpos_fun file_name compunit =
 
 (* Link in a .cma file *)
 
-let link_archive output_fun currpos_fun file_name units_required =
+let link_archive ppf output_fun currpos_fun file_name units_required =
   let inchan = open_in_bin file_name in
   try
     List.iter
       (fun cu ->
          let name = file_name ^ "(" ^ cu.cu_name ^ ")" in
          try
-           link_compunit output_fun currpos_fun inchan name cu
+           link_compunit ppf output_fun currpos_fun inchan name cu
          with Symtable.Error msg ->
            raise(Error(Symbol_error(name, msg))))
       units_required;
@@ -229,11 +240,11 @@ let link_archive output_fun currpos_fun file_name units_required =
 
 (* Link in a .cmo or .cma file *)
 
-let link_file output_fun currpos_fun = function
+let link_file ppf output_fun currpos_fun = function
     Link_object(file_name, unit) ->
-      link_object output_fun currpos_fun file_name unit
+      link_object ppf output_fun currpos_fun file_name unit
   | Link_archive(file_name, units) ->
-      link_archive output_fun currpos_fun file_name units
+      link_archive ppf output_fun currpos_fun file_name units
 
 (* Output the debugging information *)
 (* Format is:
@@ -265,7 +276,7 @@ let make_absolute file =
 
 (* Create a bytecode executable file *)
 
-let link_bytecode tolink exec_name standalone =
+let link_bytecode ppf tolink exec_name standalone =
   Misc.remove_file exec_name; (* avoid permission problems, cf PR#1911 *)
   let outchan =
     open_out_gen [Open_wronly; Open_trunc; Open_creat; Open_binary]
@@ -303,7 +314,7 @@ let link_bytecode tolink exec_name standalone =
     end;
     let output_fun = output_string outchan
     and currpos_fun () = pos_out outchan - start_code in
-    List.iter (link_file output_fun currpos_fun) tolink;
+    List.iter (link_file ppf output_fun currpos_fun) tolink;
     if standalone then Dll.close_all_dlls();
     (* The final STOP instruction *)
     output_byte outchan Opcodes.opSTOP;
@@ -402,7 +413,7 @@ let output_cds_file outfile =
 
 (* Output a bytecode executable as a C file *)
 
-let link_bytecode_as_c tolink outfile =
+let link_bytecode_as_c ppf tolink outfile =
   let outchan = open_out outfile in
   begin try
     (* The bytecode *)
@@ -424,7 +435,7 @@ let link_bytecode_as_c tolink outfile =
       output_code_string outchan code;
       currpos := !currpos + String.length code
     and currpos_fun () = !currpos in
-    List.iter (link_file output_fun currpos_fun) tolink;
+    List.iter (link_file ppf output_fun currpos_fun) tolink;
     (* The final STOP instruction *)
     Printf.fprintf outchan "\n0x%x};\n\n" Opcodes.opSTOP;
     (* The table of global data *)
@@ -491,7 +502,7 @@ let fix_exec_name name =
 
 (* Main entry point (build a custom runtime if needed) *)
 
-let link objfiles output_name =
+let link ppf objfiles output_name =
   let objfiles =
     if !Clflags.nopervasives then objfiles
     else if !Clflags.output_c_object then "stdlib.cma" :: objfiles
@@ -501,19 +512,23 @@ let link objfiles output_name =
   Clflags.ccopts := !lib_ccopts @ !Clflags.ccopts; (* put user's opts first *)
   Clflags.dllibs := !lib_dllibs @ !Clflags.dllibs; (* put user's DLLs first *)
   if not !Clflags.custom_runtime then
-    link_bytecode tolink output_name true
+    link_bytecode ppf tolink output_name true
   else if not !Clflags.output_c_object then begin
     let bytecode_name = Filename.temp_file "camlcode" "" in
     let prim_name = Filename.temp_file "camlprim" ".c" in
     try
-      link_bytecode tolink bytecode_name false;
+      link_bytecode ppf tolink bytecode_name false;
       let poc = open_out prim_name in
       output_string poc "\
         #ifdef __cplusplus\n\
         extern \"C\" {\n\
         #endif\n\
         #ifdef _WIN64\n\
+        #ifdef __MINGW32__\n\
+        typedef long long value;\n\
+        #else\n\
         typedef __int64 value;\n\
+        #endif\n\
         #else\n\
         typedef long value;\n\
         #endif\n";
@@ -540,7 +555,7 @@ let link objfiles output_name =
     if Sys.file_exists c_file then raise(Error(File_exists c_file));
     let temps = ref [] in
     try
-      link_bytecode_as_c tolink c_file;
+      link_bytecode_as_c ppf tolink c_file;
       if not (Filename.check_suffix output_name ".c") then begin
         temps := c_file :: !temps;
         if Ccomp.compile_file c_file <> 0 then raise(Error Custom_runtime);
diff --git a/bytecomp/bytelink.mli b/bytecomp/bytelink.mli
index 375bde0d5d..1366a1686f 100644
--- a/bytecomp/bytelink.mli
+++ b/bytecomp/bytelink.mli
@@ -14,9 +14,9 @@
 
 (* Link .cmo files and produce a bytecode executable. *)
 
-val link: string list -> string -> unit
+val link : Format.formatter -> string list -> string -> unit
 
-val check_consistency: string -> Cmo_format.compilation_unit -> unit
+val check_consistency: Format.formatter -> string -> Cmo_format.compilation_unit -> unit
 
 val extract_crc_interfaces: unit -> (string * Digest.t) list
 
diff --git a/bytecomp/bytepackager.ml b/bytecomp/bytepackager.ml
index 2385b99c43..fc53d54d6d 100644
--- a/bytecomp/bytepackager.ml
+++ b/bytecomp/bytepackager.ml
@@ -124,10 +124,10 @@ let read_member_info file =
    Accumulate relocs, debug info, etc.
    Return size of bytecode. *)
 
-let rename_append_bytecode packagename oc mapping defined ofs prefix subst objfile compunit =
+let rename_append_bytecode ppf packagename oc mapping defined ofs prefix subst objfile compunit =
   let ic = open_in_bin objfile in
   try
-    Bytelink.check_consistency objfile compunit;
+    Bytelink.check_consistency ppf objfile compunit;
     List.iter
       (rename_relocation packagename objfile mapping defined ofs)
       compunit.cu_reloc;
@@ -148,20 +148,20 @@ let rename_append_bytecode packagename oc mapping defined ofs prefix subst objfi
 (* Same, for a list of .cmo and .cmi files.
    Return total size of bytecode. *)
 
-let rec rename_append_bytecode_list packagename oc mapping defined ofs prefix subst = function
+let rec rename_append_bytecode_list ppf packagename oc mapping defined ofs prefix subst = function
     [] ->
       ofs
   | m :: rem ->
       match m.pm_kind with
       | PM_intf ->
-          rename_append_bytecode_list packagename oc mapping defined ofs prefix subst rem
+          rename_append_bytecode_list ppf packagename oc mapping defined ofs prefix subst rem
       | PM_impl compunit ->
           let size =
-            rename_append_bytecode packagename oc mapping defined ofs prefix subst
+            rename_append_bytecode ppf packagename oc mapping defined ofs prefix subst
                                    m.pm_file compunit in
           let id = Ident.create_persistent m.pm_name in
           let root = Path.Pident (Ident.create_persistent prefix) in
-          rename_append_bytecode_list packagename
+          rename_append_bytecode_list ppf packagename
             oc mapping (id :: defined)
             (ofs + size) prefix (Subst.add_module id (Path.Pdot (root, Ident.name id, Path.nopos)) subst) rem
 
@@ -186,7 +186,7 @@ let build_global_target oc target_name members mapping pos coercion =
 
 (* Build the .cmo file obtained by packaging the given .cmo files. *)
 
-let package_object_files files targetfile targetname coercion =
+let package_object_files ppf files targetfile targetname coercion =
   let members =
     map_left_right read_member_info files in
   let unit_names =
@@ -203,7 +203,7 @@ let package_object_files files targetfile targetname coercion =
     let pos_depl = pos_out oc in
     output_binary_int oc 0;
     let pos_code = pos_out oc in
-    let ofs = rename_append_bytecode_list targetname oc mapping [] 0 targetname Subst.identity members in
+    let ofs = rename_append_bytecode_list ppf targetname oc mapping [] 0 targetname Subst.identity members in
     build_global_target oc targetname members mapping ofs coercion;
     let pos_debug = pos_out oc in
     if !Clflags.debug && !events <> [] then
@@ -233,7 +233,7 @@ let package_object_files files targetfile targetname coercion =
 
 (* The entry point *)
 
-let package_files files targetfile =
+let package_files ppf files targetfile =
     let files =
     List.map
 	(fun f ->
@@ -245,7 +245,7 @@ let package_files files targetfile =
     let targetname = String.capitalize(Filename.basename prefix) in
     try
       let coercion = Typemod.package_units files targetcmi targetname in
-    let ret = package_object_files files targetfile targetname coercion in 
+    let ret = package_object_files ppf files targetfile targetname coercion in
     ret
   with x ->
     remove_file targetfile; raise x
diff --git a/bytecomp/bytepackager.mli b/bytecomp/bytepackager.mli
index 2a599d9f98..696b12aa09 100644
--- a/bytecomp/bytepackager.mli
+++ b/bytecomp/bytepackager.mli
@@ -15,7 +15,7 @@
 (* "Package" a set of .cmo files into one .cmo file having the
    original compilation units as sub-modules. *)
 
-val package_files: string list -> string -> unit
+val package_files: Format.formatter -> string list -> string -> unit
 
 type error =
     Forward_reference of string * Ident.t
diff --git a/bytecomp/simplif.ml b/bytecomp/simplif.ml
index e26524e676..d5f85fc3a8 100644
--- a/bytecomp/simplif.ml
+++ b/bytecomp/simplif.ml
@@ -260,6 +260,9 @@ let simplify_exits lam =
 
 let simplify_lets lam =
 
+  (* Disable optimisations for bytecode compilation with -g flag *)
+  let optimize = !Clflags.native_code || not !Clflags.debug in
+
   (* First pass: count the occurrences of all let-bound identifiers *)
 
   let occ = (Hashtbl.create 83: (Ident.t, int ref) Hashtbl.t) in
@@ -307,7 +310,7 @@ let simplify_lets lam =
       count bv l1; List.iter (count bv) ll
   | Lfunction(kind, params, l) ->
       count Tbl.empty l
-  | Llet(str, v, Lvar w, l2) when not !Clflags.debug ->
+  | Llet(str, v, Lvar w, l2) when optimize ->
       (* v will be replaced by w in l2, so each occurrence of v in l2
          increases w's refcount *)
       count (bind_var bv v) l2;
@@ -361,7 +364,6 @@ let simplify_lets lam =
      and substitute the bindings of variables used exactly once. *)
 
   let subst = Hashtbl.create 83 in
-  let optimize = !Clflags.native_code || not !Clflags.debug in
 
 (* This (small)  optimisation is always legal, it may uncover some
    tail call later on. *)
diff --git a/bytecomp/translclass.ml b/bytecomp/translclass.ml
index f06e43b461..843ef5a90a 100644
--- a/bytecomp/translclass.ml
+++ b/bytecomp/translclass.ml
@@ -142,15 +142,7 @@ let rec build_object_init cl_table obj params inh_init obj_init cl =
                    (inh_init, obj_init, has_init)
                | Cf_init _ ->
                    (inh_init, obj_init, true)
-               | Cf_let (rec_flag, defs, vals) ->
-                   (inh_init,
-                    Translcore.transl_let rec_flag defs
-                      (List.fold_right
-                         (fun (id, expr) rem ->
-                            lsequence (Lifused(id, set_inst_var obj id expr))
-                                      rem)
-                         vals obj_init),
-                    has_init))
+            )
             str.cl_field
             (inh_init, obj_init obj, false)
         in
@@ -292,11 +284,6 @@ let rec build_class_init cla cstr super inh_init cl_init msubst top cl =
                 (inh_init, cl_init,
                  Lvar (Meths.find name str.cl_meths) :: met_code @ methods,
                  values)
-            | Cf_let (rec_flag, defs, vals) ->
-                let vals =
-                  List.map (function (id, _) -> (Ident.name id, id)) vals
-                in
-                (inh_init, cl_init, methods, vals @ values)
             | Cf_init exp ->
                 (inh_init,
                  Lsequence(mkappl (oo_prim "add_initializer",
diff --git a/byterun/Makefile b/byterun/Makefile
index c8669710de..316f69e5c6 100644
--- a/byterun/Makefile
+++ b/byterun/Makefile
@@ -65,6 +65,9 @@ clean::
 	$(CC) -c $(CFLAGS) $(SHAREDCCCOMPOPTS) $*.pic.c
 	rm $*.pic.c
 
+clean::
+	rm -f *.pic.c *.d.c
+
 depend : prims.c opnames.h jumptbl.h version.h
 	-gcc -MM $(BYTECCCOMPOPTS) *.c > .depend
 	-gcc -MM $(BYTECCCOMPOPTS) -DDEBUG *.c | sed -e 's/\.o/.d.o/' >> .depend
diff --git a/byterun/alloc.h b/byterun/alloc.h
index 7e954e36ef..75dd5ec8f9 100644
--- a/byterun/alloc.h
+++ b/byterun/alloc.h
@@ -23,6 +23,10 @@
 #include "misc.h"
 #include "mlvalues.h"
 
+#ifdef __cplusplus
+extern "C" {
+#endif
+
 CAMLextern value caml_alloc (mlsize_t, tag_t);
 CAMLextern value caml_alloc_small (mlsize_t, tag_t);
 CAMLextern value caml_alloc_tuple (mlsize_t);
@@ -44,4 +48,8 @@ CAMLextern value caml_alloc_final (mlsize_t, /*size in words*/
 
 CAMLextern int caml_convert_flag_list (value, int *);
 
+#ifdef __cplusplus
+}
+#endif
+
 #endif /* CAML_ALLOC_H */
diff --git a/byterun/array.c b/byterun/array.c
index ec609d04ba..637fe9c804 100644
--- a/byterun/array.c
+++ b/byterun/array.c
@@ -1,6 +1,6 @@
 /***********************************************************************/
 /*                                                                     */
-/*                                OCaml                                */
+/*                           OCaml                                     */
 /*                                                                     */
 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
 /*                                                                     */
@@ -15,20 +15,23 @@
 
 /* Operations on arrays */
 
+#include <string.h>
 #include "alloc.h"
 #include "fail.h"
 #include "memory.h"
 #include "misc.h"
 #include "mlvalues.h"
 
-CAMLexport mlsize_t caml_array_length(value array){
-  tag_t tag = Tag_val(array);
-  if (tag == Double_array_tag)
+CAMLexport mlsize_t caml_array_length(value array)
+{
+  if (Tag_val(array) == Double_array_tag)
     return Wosize_val(array) / Double_wosize;
-  else return Wosize_val(array);
+  else
+    return Wosize_val(array);
 }
 
-CAMLexport int caml_is_double_array(value array){
+CAMLexport int caml_is_double_array(value array)
+{
   return (Tag_val(array) == Double_array_tag);
 }
 
@@ -202,3 +205,181 @@ CAMLprim value caml_make_array(value init)
     }
   }
 }
+
+/* Blitting */
+
+CAMLprim value caml_array_blit(value a1, value ofs1, value a2, value ofs2,
+                               value n)
+{
+  value * src, * dst;
+  intnat count;
+
+  if (Tag_val(a2) == Double_array_tag) {
+    /* Arrays of floats.  The values being copied are floats, not
+       pointer, so we can do a direct copy.  memmove takes care of
+       potential overlap between the copied areas. */
+    memmove((double *)a2 + Long_val(ofs2),
+            (double *)a1 + Long_val(ofs1),
+            Long_val(n) * sizeof(double));
+    return Val_unit;
+  }
+  if (Is_young(a2)) {
+    /* Arrays of values, destination is in young generation.
+       Here too we can do a direct copy since this cannot create
+       old-to-young pointers, nor mess up with the incremental major GC.
+       Again, memmove takes care of overlap. */
+    memmove(&Field(a2, Long_val(ofs2)),
+            &Field(a1, Long_val(ofs1)),
+            Long_val(n) * sizeof(value));
+    return Val_unit;
+  }
+  /* Array of values, destination is in old generation.
+     We must use caml_modify.  */
+  count = Long_val(n);
+  if (a1 == a2 && Long_val(ofs1) < Long_val(ofs2)) {
+    /* Copy in descending order */
+    for (dst = &Field(a2, Long_val(ofs2) + count - 1),
+           src = &Field(a1, Long_val(ofs1) + count - 1);
+         count > 0;
+         count--, src--, dst--) {
+      caml_modify(dst, *src);
+    }
+  } else {
+    /* Copy in ascending order */
+    for (dst = &Field(a2, Long_val(ofs2)), src = &Field(a1, Long_val(ofs1));
+         count > 0;
+         count--, src++, dst++) {
+      caml_modify(dst, *src);
+    }
+  }
+  /* Many caml_modify in a row can create a lot of old-to-young refs.
+     Give the minor GC a chance to run if it needs to. */
+  caml_check_urgent_gc(Val_unit);
+  return Val_unit;
+}
+
+/* A generic function for extraction and concatenation of sub-arrays */
+
+static value caml_array_gather(intnat num_arrays,
+                               value arrays[/*num_arrays*/],
+                               intnat offsets[/*num_arrays*/],
+                               intnat lengths[/*num_arrays*/])
+{
+  CAMLparamN(arrays, num_arrays);
+  value res;                    /* no need to register it as a root */
+  int isfloat;
+  mlsize_t i, size, wsize, count, pos;
+  value * src;
+
+  /* Determine total size and whether result array is an array of floats */
+  size = 0;
+  isfloat = 0;
+  for (i = 0; i < num_arrays; i++) {
+    size += lengths[i];
+    if (Tag_val(arrays[i]) == Double_array_tag) isfloat = 1;
+  }
+  if (size == 0) {
+    /* If total size = 0, just return empty array */
+    res = Atom(0);
+  }
+  else if (isfloat) {
+    /* This is an array of floats.  We can use memcpy directly. */
+    wsize = size * Double_wosize;
+    if (wsize > Max_wosize) caml_invalid_argument("Array.concat");
+    res = caml_alloc(wsize, Double_array_tag);
+    for (i = 0, pos = 0; i < num_arrays; i++) {
+      memcpy((double *)res + pos,
+             (double *)arrays[i] + offsets[i],
+             lengths[i] * sizeof(double));
+      pos += lengths[i];
+    }
+    Assert(pos == size);
+  }
+  else if (size > Max_wosize) {
+    /* Array of values, too big. */
+    caml_invalid_argument("Array.concat");
+  }
+  else if (size < Max_young_wosize) {
+    /* Array of values, small enough to fit in young generation.
+       We can use memcpy directly. */
+    res = caml_alloc_small(size, 0);
+    for (i = 0, pos = 0; i < num_arrays; i++) {
+      memcpy(&Field(res, pos),
+             &Field(arrays[i], offsets[i]),
+             lengths[i] * sizeof(value));
+      pos += lengths[i];
+    }
+    Assert(pos == size);
+  } else {
+    /* Array of values, must be allocated in old generation and filled
+       using caml_initialize. */
+    res = caml_alloc_shr(size, 0);
+    pos = 0;
+    for (i = 0, pos = 0; i < num_arrays; i++) {
+      for (src = &Field(arrays[i], offsets[i]), count = lengths[i];
+           count > 0;
+           count--, src++, pos++) {
+        caml_initialize(&Field(res, pos), *src);
+      }
+      /* Many caml_initialize in a row can create a lot of old-to-young
+         refs.  Give the minor GC a chance to run if it needs to. */
+      res = caml_check_urgent_gc(res);
+    }
+    Assert(pos == size);
+  }
+  CAMLreturn (res);
+}
+
+CAMLprim value caml_array_sub(value a, value ofs, value len)
+{
+  value arrays[1] = { a };
+  intnat offsets[1] = { Long_val(ofs) };
+  intnat lengths[1] = { Long_val(len) };
+  return caml_array_gather(1, arrays, offsets, lengths);
+}
+
+CAMLprim value caml_array_append(value a1, value a2)
+{
+  value arrays[2] = { a1, a2 };
+  intnat offsets[2] = { 0, 0 };
+  intnat lengths[2] = { caml_array_length(a1), caml_array_length(a2) };
+  return caml_array_gather(2, arrays, offsets, lengths);
+}
+
+CAMLprim value caml_array_concat(value al)
+{
+#define STATIC_SIZE 16
+  value static_arrays[STATIC_SIZE], * arrays;
+  intnat static_offsets[STATIC_SIZE], * offsets;
+  intnat static_lengths[STATIC_SIZE], * lengths;
+  intnat n, i;
+  value l, res;
+
+  /* Length of list = number of arrays */
+  for (n = 0, l = al; l != Val_int(0); l = Field(l, 1)) n++;
+  /* Allocate extra storage if too many arrays */
+  if (n <= STATIC_SIZE) {
+    arrays = static_arrays;
+    offsets = static_offsets;
+    lengths = static_lengths;
+  } else {
+    arrays = caml_stat_alloc(n * sizeof(value));
+    offsets = caml_stat_alloc(n * sizeof(intnat));
+    lengths = caml_stat_alloc(n * sizeof(value));
+  }
+  /* Build the parameters to caml_array_gather */
+  for (i = 0, l = al; l != Val_int(0); l = Field(l, 1), i++) {
+    arrays[i] = Field(l, 0);
+    offsets[i] = 0;
+    lengths[i] = caml_array_length(Field(l, 0));
+  }
+  /* Do the concatenation */
+  res = caml_array_gather(n, arrays, offsets, lengths);
+  /* Free the extra storage if needed */
+  if (n > STATIC_SIZE) {
+    caml_stat_free(arrays);
+    caml_stat_free(offsets);
+    caml_stat_free(lengths);
+  }
+  return res;
+}
diff --git a/byterun/callback.h b/byterun/callback.h
index 550053add3..829f6b8841 100644
--- a/byterun/callback.h
+++ b/byterun/callback.h
@@ -23,6 +23,10 @@
 #endif
 #include "mlvalues.h"
 
+#ifdef __cplusplus
+extern "C" {
+#endif
+
 CAMLextern value caml_callback (value closure, value arg);
 CAMLextern value caml_callback2 (value closure, value arg1, value arg2);
 CAMLextern value caml_callback3 (value closure, value arg1, value arg2,
@@ -46,4 +50,8 @@ CAMLextern void caml_startup (char ** argv);
 
 CAMLextern int caml_callback_depth;
 
+#ifdef __cplusplus
+}
+#endif
+
 #endif
diff --git a/byterun/custom.h b/byterun/custom.h
index f71fb4fe16..c6abad8ef0 100644
--- a/byterun/custom.h
+++ b/byterun/custom.h
@@ -43,6 +43,11 @@ struct custom_operations {
 
 #define Custom_ops_val(v) (*((struct custom_operations **) (v)))
 
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+
 CAMLextern value caml_alloc_custom(struct custom_operations * ops,
                                    uintnat size, /*size in bytes*/
                                    mlsize_t mem, /*resources consumed*/
@@ -61,4 +66,8 @@ extern struct custom_operations *
 extern void caml_init_custom_operations(void);
 /* </private> */
 
+#ifdef __cplusplus
+}
+#endif
+
 #endif /* CAML_CUSTOM_H */
diff --git a/byterun/fail.h b/byterun/fail.h
index 91b2bcb7b0..ee05eb7f8a 100644
--- a/byterun/fail.h
+++ b/byterun/fail.h
@@ -58,6 +58,10 @@ int caml_is_special_exception(value exn);
 
 /* </private> */
 
+#ifdef __cplusplus
+extern "C" {
+#endif
+
 CAMLextern void caml_raise (value bucket) Noreturn;
 CAMLextern void caml_raise_constant (value tag) Noreturn;
 CAMLextern void caml_raise_with_arg (value tag, value arg) Noreturn;
@@ -75,4 +79,8 @@ CAMLextern void caml_init_exceptions (void);
 CAMLextern void caml_array_bound_error (void) Noreturn;
 CAMLextern void caml_raise_sys_blocked_io (void) Noreturn;
 
+#ifdef __cplusplus
+}
+#endif
+
 #endif /* CAML_FAIL_H */
diff --git a/byterun/floats.c b/byterun/floats.c
index 51cfb23f18..f708d70f70 100644
--- a/byterun/floats.c
+++ b/byterun/floats.c
@@ -28,6 +28,12 @@
 #include "reverse.h"
 #include "stacks.h"
 
+#ifdef _MSC_VER
+#include <float.h>
+#define isnan _isnan
+#define isfinite _finite
+#endif
+
 #ifdef ARCH_ALIGN_DOUBLE
 
 CAMLexport double caml_Double_val(value val)
@@ -77,7 +83,11 @@ CAMLprim value caml_format_float(value fmt, value arg)
   char * p;
   char * dest;
   value res;
+  double d = Double_val(arg);
 
+#ifdef HAS_BROKEN_PRINTF
+  if (isfinite(d)) {
+#endif
   prec = MAX_DIGITS;
   for (p = String_val(fmt); *p != 0; p++) {
     if (*p >= '0' && *p <= '9') {
@@ -98,11 +108,30 @@ CAMLprim value caml_format_float(value fmt, value arg)
   } else {
     dest = caml_stat_alloc(prec);
   }
-  sprintf(dest, String_val(fmt), Double_val(arg));
+  sprintf(dest, String_val(fmt), d);
   res = caml_copy_string(dest);
   if (dest != format_buffer) {
     caml_stat_free(dest);
   }
+#ifdef HAS_BROKEN_PRINTF
+  } else {
+    if (isnan(d))
+    {
+      res = caml_copy_string("nan");
+    }
+    else
+    {
+      if (d > 0)
+      {
+        res = caml_copy_string("inf");
+      }
+      else
+      {
+        res = caml_copy_string("-inf");
+      }
+    }
+  }
+#endif
   return res;
 }
 
diff --git a/byterun/intern.c b/byterun/intern.c
index 9fa403ad66..35d293b603 100644
--- a/byterun/intern.c
+++ b/byterun/intern.c
@@ -19,6 +19,7 @@
 
 #include <string.h>
 #include "alloc.h"
+#include "callback.h"
 #include "custom.h"
 #include "fail.h"
 #include "gc.h"
@@ -63,6 +64,10 @@ static value intern_block;
 /* Point to the heap block allocated as destination block.
    Meaningful only if intern_extra_block is NULL. */
 
+static value * camlinternaloo_last_id = NULL;
+/* Pointer to a reference holding the last object id.
+   -1 means not available (CamlinternalOO not loaded). */
+
 #define Sign_extend_shift ((sizeof(intnat) - 1) * 8)
 #define Sign_extend(x) (((intnat)(x) << Sign_extend_shift) >> Sign_extend_shift)
 
@@ -139,6 +144,22 @@ static void intern_rec(value *dest)
         dest = (value *) (intern_dest + 1);
         *intern_dest = Make_header(size, tag, intern_color);
         intern_dest += 1 + size;
+        /* For objects, we need to freshen the oid */
+        if (tag == Object_tag && camlinternaloo_last_id != (value*)-1) {
+          intern_rec(dest++);
+          intern_rec(dest++);
+          if (camlinternaloo_last_id == NULL)
+            camlinternaloo_last_id = caml_named_value("CamlinternalOO.last_id");
+          if (camlinternaloo_last_id == NULL)
+            camlinternaloo_last_id = (value*)-1;
+          else {
+            value id = Field(*camlinternaloo_last_id,0);
+            Field(dest,-1) = id;
+            Field(*camlinternaloo_last_id,0) = id + 2;
+          }
+          size -= 2;
+          if (size == 0) return;
+        }
         for(/*nothing*/; size > 1; size--, dest++)
           intern_rec(dest);
         goto tailcall;
@@ -328,6 +349,8 @@ static void intern_alloc(mlsize_t whsize, mlsize_t num_objects)
 {
   mlsize_t wosize;
 
+  if (camlinternaloo_last_id == (value*)-1)
+    camlinternaloo_last_id = NULL; /* Reset ignore flag */
   if (whsize == 0) {
     intern_obj_table = NULL;
     intern_extra_block = NULL;
diff --git a/byterun/intext.h b/byterun/intext.h
index 05fc614419..b771a34ad8 100644
--- a/byterun/intext.h
+++ b/byterun/intext.h
@@ -81,6 +81,10 @@ void caml_output_val (struct channel * chan, value v, value flags);
 
 /* </private> */
 
+#ifdef __cplusplus
+extern "C" {
+#endif
+
 CAMLextern void caml_output_value_to_malloc(value v, value flags,
                                             /*out*/ char ** buf,
                                             /*out*/ intnat * len);
@@ -159,4 +163,8 @@ extern char * caml_code_area_start, * caml_code_area_end;
 
 /* </private> */
 
+#ifdef __cplusplus
+}
+#endif
+
 #endif /* CAML_INTEXT_H */
diff --git a/byterun/memory.c b/byterun/memory.c
index 2a98ada34a..b0801f130b 100644
--- a/byterun/memory.c
+++ b/byterun/memory.c
@@ -353,7 +353,7 @@ void caml_shrink_heap (char *chunk)
 {
   char **cp;
 
-  /* Never deallocate the first block, because caml_heap_start is both the
+  /* Never deallocate the first chunk, because caml_heap_start is both the
      first block and the base address for page numbers, and we don't
      want to shift the page table, it's too messy (see above).
      It will never happen anyway, because of the way compaction works.
diff --git a/byterun/memory.h b/byterun/memory.h
index 0c659b84e8..cbeeb756fa 100644
--- a/byterun/memory.h
+++ b/byterun/memory.h
@@ -30,6 +30,11 @@
 #include "misc.h"
 #include "mlvalues.h"
 
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+
 CAMLextern value caml_alloc_shr (mlsize_t, tag_t);
 CAMLextern void caml_adjust_gc_speed (mlsize_t, mlsize_t);
 CAMLextern void caml_alloc_dependent_memory (mlsize_t);
@@ -456,4 +461,8 @@ CAMLextern void caml_remove_generational_global_root (value *);
 
 CAMLextern void caml_modify_generational_global_root(value *r, value newval);
 
+#ifdef __cplusplus
+}
+#endif
+
 #endif /* CAML_MEMORY_H */
diff --git a/byterun/mlvalues.h b/byterun/mlvalues.h
index 201b86bda0..d560d1b3ae 100644
--- a/byterun/mlvalues.h
+++ b/byterun/mlvalues.h
@@ -22,6 +22,10 @@
 #include "config.h"
 #include "misc.h"
 
+#ifdef __cplusplus
+extern "C" {
+#endif
+
 /* Definitions
 
   word: Four bytes on 32 and 16 bit architectures,
@@ -294,5 +298,9 @@ CAMLextern header_t caml_atom_table[];
 
 extern value caml_global_data;
 
+#ifdef __cplusplus
+}
+#endif
+
 
 #endif /* CAML_MLVALUES_H */
diff --git a/byterun/obj.c b/byterun/obj.c
index 72464b315f..f095df5ae6 100644
--- a/byterun/obj.c
+++ b/byterun/obj.c
@@ -191,7 +191,7 @@ CAMLprim value caml_lazy_make_forward (value v)
   CAMLlocal1 (res);
 
   res = caml_alloc_small (1, Forward_tag);
-  Modify (&Field (res, 0), v);
+  Field (res, 0) = v;
   CAMLreturn (res);
 }
 
diff --git a/byterun/parsing.c b/byterun/parsing.c
index aeba38d622..3d5ea83323 100644
--- a/byterun/parsing.c
+++ b/byterun/parsing.c
@@ -125,7 +125,7 @@ static void print_token(struct parser_tables *tables, int state, value tok)
             state, token_name(tables->names_block, Tag_val(tok)));
     v = Field(tok, 0);
     if (Is_long(v))
-      fprintf(stderr, "%ld", Long_val(v));
+      fprintf(stderr, "%" ARCH_INTNAT_PRINTF_FORMAT "d", Long_val(v));
     else if (Tag_val(v) == String_tag)
       fprintf(stderr, "%s", String_val(v));
     else if (Tag_val(v) == Double_tag)
diff --git a/byterun/printexc.c b/byterun/printexc.c
index f50853d90a..e891d9c677 100644
--- a/byterun/printexc.c
+++ b/byterun/printexc.c
@@ -73,7 +73,7 @@ CAMLexport char * caml_format_exception(value exn)
       if (i > start) add_string(&buf, ", ");
       v = Field(bucket, i);
       if (Is_long(v)) {
-        sprintf(intbuf, "%ld", Long_val(v));
+        sprintf(intbuf, "%" ARCH_INTNAT_PRINTF_FORMAT "d", Long_val(v));
         add_string(&buf, intbuf);
       } else if (Tag_val(v) == String_tag) {
         add_char(&buf, '"');
diff --git a/byterun/printexc.h b/byterun/printexc.h
index 5b0549b23f..4624086cb3 100644
--- a/byterun/printexc.h
+++ b/byterun/printexc.h
@@ -20,8 +20,16 @@
 #include "misc.h"
 #include "mlvalues.h"
 
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+
 CAMLextern char * caml_format_exception (value);
 void caml_fatal_uncaught_exception (value) Noreturn;
 
+#ifdef __cplusplus
+}
+#endif
 
 #endif /* CAML_PRINTEXC_H */
diff --git a/byterun/signals.h b/byterun/signals.h
index f771a799e8..fb03b30dd5 100644
--- a/byterun/signals.h
+++ b/byterun/signals.h
@@ -22,6 +22,10 @@
 #include "misc.h"
 #include "mlvalues.h"
 
+#ifdef __cplusplus
+extern "C" {
+#endif
+
 /* <private> */
 CAMLextern intnat volatile caml_signals_are_pending;
 CAMLextern intnat volatile caml_pending_signals[];
@@ -48,4 +52,8 @@ CAMLextern int (*caml_try_leave_blocking_section_hook)(void);
 CAMLextern void (* volatile caml_async_action_hook)(void);
 /* </private> */
 
+#ifdef __cplusplus
+}
+#endif
+
 #endif /* CAML_SIGNALS_H */
diff --git a/camlp4/Camlp4/Debug.ml b/camlp4/Camlp4/Debug.ml
index 2d901f3e98..73a38db89f 100644
--- a/camlp4/Camlp4/Debug.ml
+++ b/camlp4/Camlp4/Debug.ml
@@ -50,24 +50,15 @@ value mode =
 
 value formatter =
   let header = "camlp4-debug: " in
-  let normal s =
-    let rec self from accu =
-      try
-        let i = String.index_from s from '\n'
-        in self (i + 1) [String.sub s from (i - from + 1) :: accu]
-      with
-      [ Not_found -> [ String.sub s from (String.length s - from) :: accu ] ]
-    in String.concat header (List.rev (self 0 [])) in
-  let after_new_line str = header ^ normal str in
-  let f = ref after_new_line in
-  let output str chr = do {
-    output_string out_channel (f.val str);
-    output_char out_channel chr;
-    f.val := if chr = '\n' then after_new_line else normal;
-  } in
+  let at_bol = ref True in
   (make_formatter
     (fun buf pos len ->
-      let p = pred len in output (String.sub buf pos p) buf.[pos + p])
+       for i = pos to pos + len - 1 do
+         if at_bol.val then output_string out_channel header else ();
+         let ch = buf.[i];
+         output_char out_channel ch;
+         at_bol.val := ch = '\n';
+       done)
     (fun () -> flush out_channel));
 
 value printf section fmt = fprintf formatter ("%s: " ^^ fmt) section;
diff --git a/camlp4/Camlp4/Printers/OCaml.ml b/camlp4/Camlp4/Printers/OCaml.ml
index 24c4bac1a1..def7f196a2 100644
--- a/camlp4/Camlp4/Printers/OCaml.ml
+++ b/camlp4/Camlp4/Printers/OCaml.ml
@@ -106,10 +106,7 @@ module Make (Syntax : Sig.Camlp4Syntax) = struct
           "Cannot print %S this identifier does not respect OCaml lexing rules (%s)"
           str (Lexer.Error.to_string exn)) ];
 
-  value ocaml_char =
-    fun
-    [ "'" -> "\\'"
-    | c -> c ];
+  value ocaml_char x = x;
 
   value rec get_expr_args a al =
     match a with
@@ -559,7 +556,7 @@ module Make (Syntax : Sig.Camlp4Syntax) = struct
     | <:expr< $int64:s$ >> -> o#numeric f s "L"
     | <:expr< $int32:s$ >> -> o#numeric f s "l"
     | <:expr< $flo:s$ >> -> o#numeric f s ""
-    | <:expr< $chr:s$ >> -> pp f "'%s'" (ocaml_char s)
+    | <:expr< $chr:s$ >> -> pp f "'%s'" s
     | <:expr< $id:i$ >> -> o#var_ident f i
     | <:expr< { $b$ } >> ->
         pp f "@[<hv0>@[<hv2>{%a@]@ }@]" o#record_binding b
@@ -669,7 +666,7 @@ module Make (Syntax : Sig.Camlp4Syntax) = struct
     | <:patt< $int32:s$ >> -> o#numeric f s "l"
     | <:patt< $int:s$ >> -> o#numeric f s ""
     | <:patt< $flo:s$ >> -> o#numeric f s ""
-    | <:patt< $chr:s$ >> -> pp f "'%s'" (ocaml_char s)
+    | <:patt< $chr:s$ >> -> pp f "'%s'" s
     | <:patt< ~ $s$ >> -> pp f "~%s" s
     | <:patt< ` $uid:s$ >> -> pp f "`%a" o#var s
     | <:patt< # $i$ >> -> pp f "@[<2>#%a@]" o#ident i
@@ -951,7 +948,7 @@ module Make (Syntax : Sig.Camlp4Syntax) = struct
     let () = o#node f ce Ast.loc_of_class_expr in
     match ce with
     [ <:class_expr< $ce$ $e$ >> ->
-          pp f "@[<2>%a@ %a@]" o#class_expr ce o#expr e
+          pp f "@[<2>%a@ %a@]" o#class_expr ce o#apply_expr e
     | <:class_expr< $id:i$ >> ->
           pp f "@[<2>%a@]" o#ident i
     | <:class_expr< $id:i$ [ $t$ ] >> ->
diff --git a/camlp4/Camlp4Parsers/Camlp4MacroParser.ml b/camlp4/Camlp4Parsers/Camlp4MacroParser.ml
index c29cdd7347..840bc5ec1a 100644
--- a/camlp4/Camlp4Parsers/Camlp4MacroParser.ml
+++ b/camlp4/Camlp4Parsers/Camlp4MacroParser.ml
@@ -52,6 +52,7 @@ Added statements:
      DEFINE <lident> = <expression> IN <expression>
      __FILE__
      __LOCATION__
+     LOCATION_OF <parameter>
 
   In patterns:
 
@@ -84,6 +85,10 @@ Added statements:
 
   The expression __FILE__ returns the current compiled file name.
   The expression __LOCATION__ returns the current location of itself.
+  If used inside a macro, it returns the location where the macro is
+  called.
+  The expression (LOCATION_OF parameter) returns the location of the given
+  macro parameter. It cannot be used outside a macro definition.
 
 *)
 
@@ -151,6 +156,15 @@ module Make (Syntax : Sig.Camlp4Syntax) = struct
       [ <:expr< $lid:x$ >> | <:expr< $uid:x$ >> as e ->
           try List.assoc x env with
           [ Not_found -> super#expr e ]
+      | <:expr@_loc< LOCATION_OF $lid:x$ >> | <:expr@_loc< LOCATION_OF $uid:x$ >> as e ->
+          try
+            let loc = Ast.loc_of_expr (List.assoc x env) in
+            let (a, b, c, d, e, f, g, h) = Loc.to_tuple loc in
+            <:expr< Loc.of_tuple
+              ($`str:a$, $`int:b$, $`int:c$, $`int:d$,
+               $`int:e$, $`int:f$, $`int:g$,
+               $if h then <:expr< True >> else <:expr< False >> $) >>
+          with [ Not_found -> super#expr e ]
       | e -> super#expr e ];
 
     method patt =
@@ -387,15 +401,6 @@ module Make (Syntax : Sig.Camlp4Syntax) = struct
         | "DEFINE"; i = LIDENT; "="; def = expr; "IN"; body = expr ->
             (new subst _loc [(i, def)])#expr body ] ]
     ;
-    expr: LEVEL "simple"
-      [ [ LIDENT "__FILE__" -> <:expr< $`str:Loc.file_name _loc$ >>
-        | LIDENT "__LOCATION__" ->
-            let (a, b, c, d, e, f, g, h) = Loc.to_tuple _loc in
-            <:expr< Loc.of_tuple
-                ($`str:a$, $`int:b$, $`int:c$, $`int:d$,
-                 $`int:e$, $`int:f$, $`int:g$,
-                 $if h then <:expr< True >> else <:expr< False >> $) >> ] ]
-    ;
     patt:
       [ [ "IFDEF"; i = uident; "THEN"; p1 = patt; "ELSE"; p2 = patt; endif ->
             if is_defined i then p1 else p2
@@ -434,12 +439,20 @@ module MakeNothing (AstFilters : Camlp4.Sig.AstFilters) = struct
  open AstFilters;
  open Ast;
 
- value remove_nothings =
+ (* Remove NOTHING and expanse __FILE__ and __LOCATION__ *)
+ value map_expr =
    fun
    [ <:expr< $e$ NOTHING >> | <:expr< fun $ <:patt< NOTHING >> $ -> $e$ >> -> e
+   | <:expr@_loc< $lid:"__FILE__"$ >> -> <:expr< $`str:Loc.file_name _loc$ >>
+   | <:expr@_loc< $lid:"__LOCATION__"$ >> ->
+     let (a, b, c, d, e, f, g, h) = Loc.to_tuple _loc in
+     <:expr< Loc.of_tuple
+       ($`str:a$, $`int:b$, $`int:c$, $`int:d$,
+        $`int:e$, $`int:f$, $`int:g$,
+        $if h then <:expr< True >> else <:expr< False >> $) >>
    | e -> e];
 
- register_str_item_filter (Ast.map_expr remove_nothings)#str_item;
+ register_str_item_filter (Ast.map_expr map_expr)#str_item;
 
 end;
 
diff --git a/camlp4/Camlp4Parsers/Camlp4OCamlParser.ml b/camlp4/Camlp4Parsers/Camlp4OCamlParser.ml
index 36606cdd31..3d841516e4 100644
--- a/camlp4/Camlp4Parsers/Camlp4OCamlParser.ml
+++ b/camlp4/Camlp4Parsers/Camlp4OCamlParser.ml
@@ -584,9 +584,13 @@ module Make (Syntax : Sig.Camlp4Syntax) = struct
     ;
     type_kind:
       [ [ "private"; tk = type_kind -> <:ctyp< private $tk$ >>
-        | t = TRY [OPT "|"; t = constructor_declarations;
-                   test_not_dot_nor_lparen -> t] ->
-            <:ctyp< [ $t$ ] >>
+        | (x, t) = TRY [x = OPT "|"; t = constructor_declarations;
+                        test_not_dot_nor_lparen -> (x, t)] ->
+            (* If there is no "|" and [t] is an antiquotation,
+               then it is not a sum type. *)
+            match (x, t) with
+            [ (None, Ast.TyAnt _) -> t
+            | _ -> <:ctyp< [ $t$ ] >> ]
         | t = TRY ctyp -> <:ctyp< $t$ >>
         | t = TRY ctyp; "="; "private"; tk = type_kind ->
             <:ctyp< $t$ == private $tk$ >>
diff --git a/camlp4/Camlp4Parsers/Camlp4OCamlRevisedParser.ml b/camlp4/Camlp4Parsers/Camlp4OCamlRevisedParser.ml
index 5ccb69321b..52dab40f45 100644
--- a/camlp4/Camlp4Parsers/Camlp4OCamlRevisedParser.ml
+++ b/camlp4/Camlp4Parsers/Camlp4OCamlRevisedParser.ml
@@ -1782,13 +1782,19 @@ New syntax:\
     ;
     str_item_quot:
       [ [ "#"; n = a_LIDENT; dp = opt_expr -> <:str_item< # $n$ $dp$ >>
-        | st1 = str_item; semi; st2 = SELF -> <:str_item< $st1$; $st2$ >>
+        | st1 = str_item; semi; st2 = SELF ->
+            match st2 with
+            [ <:str_item<>> -> st1
+            | _ -> <:str_item< $st1$; $st2$ >> ]
         | st = str_item -> st
         | -> <:str_item<>> ] ]
     ;
     sig_item_quot:
       [ [ "#"; n = a_LIDENT; dp = opt_expr -> <:sig_item< # $n$ $dp$ >>
-        | sg1 = sig_item; semi; sg2 = SELF -> <:sig_item< $sg1$; $sg2$ >>
+        | sg1 = sig_item; semi; sg2 = SELF ->
+            match sg2 with
+            [ <:sig_item<>> -> sg1
+            | _ -> <:sig_item< $sg1$; $sg2$ >> ]
         | sg = sig_item -> sg
         | -> <:sig_item<>> ] ]
     ;
@@ -1873,12 +1879,17 @@ New syntax:\
     ;
     class_str_item_quot:
       [ [ x1 = class_str_item; semi; x2 = SELF ->
-          <:class_str_item< $x1$; $x2$ >>
+          match x2 with
+          [ <:class_str_item<>> -> x1
+          | _ -> <:class_str_item< $x1$; $x2$ >> ]
         | x = class_str_item -> x
         | -> <:class_str_item<>> ] ]
     ;
     class_sig_item_quot:
-      [ [ x1 = class_sig_item; semi; x2 = SELF -> <:class_sig_item< $x1$; $x2$ >>
+      [ [ x1 = class_sig_item; semi; x2 = SELF ->
+          match x2 with
+          [ <:class_sig_item<>> -> x1
+          | _ -> <:class_sig_item< $x1$; $x2$ >> ]
         | x = class_sig_item -> x
         | -> <:class_sig_item<>> ] ]
     ;
diff --git a/camlp4/boot/Camlp4Ast.ml b/camlp4/boot/Camlp4Ast.ml
index fb8a0a61c4..da35700cd2 100644
--- a/camlp4/boot/Camlp4Ast.ml
+++ b/camlp4/boot/Camlp4Ast.ml
@@ -471,10 +471,10 @@ module Make (Loc : Sig.Loc) : Sig.Camlp4Ast with module Loc = Loc =
             value meta_loc = meta_loc_expr;
             module Expr =
               struct
-                value meta_string _loc s = Ast.ExStr _loc s;
+                value meta_string _loc s = Ast.ExStr _loc (safe_string_escaped s);
                 value meta_int _loc s = Ast.ExInt _loc s;
                 value meta_float _loc s = Ast.ExFlo _loc s;
-                value meta_char _loc s = Ast.ExChr _loc s;
+                value meta_char _loc s = Ast.ExChr _loc (String.escaped s);
                 value meta_bool _loc =
                   fun
                   [ False -> Ast.ExId _loc (Ast.IdUid _loc "False")
diff --git a/config/Makefile-templ b/config/Makefile-templ
index fc8b9a0259..626d30e842 100644
--- a/config/Makefile-templ
+++ b/config/Makefile-templ
@@ -86,6 +86,9 @@ RANLIBCMD=ranlib
 #RANLIB=ar rs
 #RANLIBCMD=
 
+### How to invoke ar
+#ARCMD=ar
+
 ### Shared library support
 # Extension for shared libraries: so if supported, a if not supported
 #SO=so
diff --git a/config/Makefile.mingw b/config/Makefile.mingw
index e3b794d80f..0aea48ceb7 100644
--- a/config/Makefile.mingw
+++ b/config/Makefile.mingw
@@ -120,6 +120,9 @@ SYSLIB=-l$(1)
 RANLIB=$(TOOLPREF)ranlib
 RANLIBCMD=$(TOOLPREF)ranlib
 
+### The ar command
+ARCMD=$(TOOLPREF)ar
+
 ############# Configuration for the native-code compiler
 
 ### Name of architecture for the native-code compiler
diff --git a/config/Makefile.mingw64 b/config/Makefile.mingw64
new file mode 100644
index 0000000000..d4a0564114
--- /dev/null
+++ b/config/Makefile.mingw64
@@ -0,0 +1,164 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#            Xavier Leroy, projet Cristal, INRIA Rocquencourt           #
+#                                                                       #
+#   Copyright 1999 Institut National de Recherche en Informatique et    #
+#   en Automatique.  All rights reserved.  This file is distributed     #
+#   under the terms of the GNU Library General Public License, with     #
+#   the special exception on linking described in file ../LICENSE.      #
+#                                                                       #
+#########################################################################
+
+# $Id: Makefile.mingw 11319 2011-12-16 17:02:48Z xleroy $
+
+# Configuration for Windows, Mingw compiler
+
+######### General configuration
+
+PREFIX=C:/ocamlmgw64
+
+### Where to install the binaries
+BINDIR=$(PREFIX)/bin
+
+### Where to install the standard library
+LIBDIR=$(PREFIX)/lib
+
+### Where to install the stub DLLs
+STUBLIBDIR=$(LIBDIR)/stublibs
+
+### Where to install the info files
+DISTRIB=$(PREFIX)
+
+### Where to install the man pages
+MANDIR=$(PREFIX)/man
+
+########## Toolchain and OS dependencies
+
+TOOLCHAIN=mingw
+
+### Toolchain prefix
+TOOLPREF=x86_64-w64-mingw32-
+
+CCOMPTYPE=cc
+O=o
+A=a
+S=s
+SO=s.o
+DO=d.o
+EXE=.exe
+EXT_DLL=.dll
+EXT_OBJ=.$(O)
+EXT_LIB=.$(A)
+EXT_ASM=.$(S)
+MANEXT=1
+SHARPBANGSCRIPTS=false
+PTHREAD_LINK=
+X11_INCLUDES=
+X11_LINK=
+DBM_INCLUDES=
+DBM_LINK=
+BYTECCRPATH=
+SUPPORTS_SHARED_LIBRARIES=true
+SHAREDCCCOMPOPTS=
+MKSHAREDLIBRPATH=
+NATIVECCPROFOPTS=
+NATIVECCRPATH=
+ASM=$(TOOLPREF)as
+ASPP=gcc
+ASPPPROFFLAGS=
+PROFILING=noprof
+RUNTIMED=noruntimed
+DYNLINKOPTS=
+DEBUGGER=ocamldebugger
+CC_PROFILE=
+SYSTHREAD_SUPPORT=true
+EXTRALIBS=
+NATDYNLINK=true
+CMXS=cmxs
+RUNTIMED=noruntimed
+
+########## Configuration for the bytecode compiler
+
+### Which C compiler to use for the bytecode interpreter.
+BYTECC=$(TOOLPREF)gcc
+
+### Additional compile-time options for $(BYTECC).  (For static linking.)
+BYTECCCOMPOPTS=-O -mms-bitfields -Wall -Wno-unused
+
+### Additional link-time options for $(BYTECC).  (For static linking.)
+BYTECCLINKOPTS=
+
+### Additional compile-time options for $(BYTECC).  (For building a DLL.)
+DLLCCCOMPOPTS=-O -mms-bitfields -Wall -Wno-unused -DCAML_DLL
+
+### Libraries needed
+BYTECCLIBS=-lws2_32
+NATIVECCLIBS=-lws2_32
+
+### How to invoke the C preprocessor
+CPP=$(BYTECC) -E
+
+### Flexlink
+FLEXLINK=flexlink -chain mingw64
+FLEXDIR=$(shell $(FLEXLINK) -where)
+IFLEXDIR=-I"$(FLEXDIR)"
+MKDLL=$(FLEXLINK)
+MKEXE=$(FLEXLINK) -exe
+MKMAINDLL=$(FLEXLINK) -maindll
+
+### How to build a static library
+MKLIB=rm -f $(1); $(TOOLPREF)ar rc $(1) $(2); $(RANLIB) $(1)
+#ml let mklib out files opts = Printf.sprintf "rm -f %s && %sar rcs %s %s %s" out toolpref opts out files;;
+
+### Canonicalize the name of a system library
+SYSLIB=-l$(1)
+#ml let syslib x = "-l"^x;;
+
+### The ranlib command
+RANLIB=$(TOOLPREF)ranlib
+RANLIBCMD=$(TOOLPREF)ranlib
+
+### The ar command
+ARCMD=$(TOOLPREF)ar
+
+############# Configuration for the native-code compiler
+
+### Name of architecture for the native-code compiler
+ARCH=amd64
+
+### Name of architecture model for the native-code compiler.
+MODEL=default
+
+### Name of operating system family for the native-code compiler.
+SYSTEM=mingw64
+
+### Which C compiler to use for the native-code compiler.
+NATIVECC=$(BYTECC)
+
+### Additional compile-time options for $(NATIVECC).
+NATIVECCCOMPOPTS=-O -mms-bitfields -Wall -Wno-unused
+
+### Additional link-time options for $(NATIVECC)
+NATIVECCLINKOPTS=
+
+### Build partially-linked object file
+PACKLD=$(TOOLPREF)ld -r $(NATIVECCLINKOPTS) -o #there must be a space after this '-o'
+
+############# Configuration for the contributed libraries
+
+OTHERLIBRARIES=win32unix str num win32graph dynlink bigarray systhreads
+
+### Name of the target architecture for the "num" library
+BNG_ARCH=amd64
+BNG_ASM_LEVEL=1
+
+### Configuration for LablTk (not supported)
+TK_DEFS=
+TK_LINK=
+
+############# Aliases for common commands
+
+MAKEREC=$(MAKE) -f Makefile.nt
+MAKECMD=$(MAKE)
diff --git a/config/Makefile.msvc b/config/Makefile.msvc
index 0f6eb4cc9f..592aff8874 100644
--- a/config/Makefile.msvc
+++ b/config/Makefile.msvc
@@ -115,6 +115,9 @@ SYSLIB=$(1).lib
 RANLIB=echo
 RANLIBCMD=
 
+### The ar command
+ARCMD=
+
 ############# Configuration for the native-code compiler
 
 ### Name of architecture for the native-code compiler
diff --git a/config/Makefile.msvc64 b/config/Makefile.msvc64
index 64e09d1f76..2b3edcd56e 100644
--- a/config/Makefile.msvc64
+++ b/config/Makefile.msvc64
@@ -120,6 +120,9 @@ SYSLIB=$(1).lib
 RANLIB=echo
 RANLIBCMD=
 
+### The ar command
+ARCMD=
+
 ############# Configuration for the native-code compiler
 
 ### Name of architecture for the native-code compiler
diff --git a/config/s-nt.h b/config/s-nt.h
index d3502401d4..b21b7158a9 100644
--- a/config/s-nt.h
+++ b/config/s-nt.h
@@ -27,3 +27,4 @@
 #define HAS_MKTIME
 #define HAS_PUTENV
 #define HAS_LOCALE
+#define HAS_BROKEN_PRINTF
diff --git a/configure b/configure
index 7b2d5de126..94aed58af8 100755
--- a/configure
+++ b/configure
@@ -780,6 +780,9 @@ else
   echo "RANLIBCMD=" >> Makefile
 fi
 
+echo "ARCMD=ar" >> Makefile
+
+
 # Do #! scripts work?
 
 if (SHELL=/bin/sh; export SHELL; (./sharpbang || ./sharpbang2) >/dev/null); then
@@ -1312,7 +1315,10 @@ for dir in \
     /lib/usr/lib/X11      \
                           \
     /usr/openwin/lib      \
-    /usr/openwin/share/lib \
+    /usr/openwin/share/lib    \
+                              \
+    /usr/lib/i386-linux-gnu   \
+    /usr/lib/x86_64-linux-gnu \
     ; \
 do
   if test -f $dir/libX11.a || \
@@ -1325,6 +1331,7 @@ do
     else
       x11_libs="-L$dir"
       case "$host" in
+        *-kfreebsd*-gnu) x11_link="-L$dir -lX11";;
         *-*-*bsd*) x11_link="-R$dir -L$dir -lX11";;
         *) x11_link="-L$dir -lX11";;
       esac
@@ -1444,10 +1451,6 @@ if test $has_tk = true; then
   fi
 fi
 
-case "$host" in
-  *-*-cygwin*) tk_libs="$tk_libs -lws2_32";;
-esac
-
 if test $has_tk = true; then
   if sh ./hasgot $tk_libs $tk_x11_libs $tkauxlibs Tk_SetGrid; then
     echo "Tcl/Tk libraries found."
diff --git a/driver/main.ml b/driver/main.ml
index e3dea594ea..5c47a74ddf 100644
--- a/driver/main.ml
+++ b/driver/main.ml
@@ -75,10 +75,12 @@ let print_standard_library () =
 
 let usage = "Usage: ocamlc <options> <files>\nOptions are:"
 
+let ppf = Format.err_formatter
+
 (* Error messages to standard error formatter *)
-let anonymous = process_file Format.err_formatter;;
-let impl = process_implementation_file Format.err_formatter;;
-let intf = process_interface_file Format.err_formatter;;
+let anonymous = process_file ppf;;
+let impl = process_implementation_file ppf;;
+let intf = process_interface_file ppf;;
 
 let show_config () =
   Config.print_config stdout;
@@ -170,14 +172,14 @@ let main () =
     if !make_archive then begin
       Compile.init_path();
 
-      Bytelibrarian.create_archive (List.rev !objfiles)
+      Bytelibrarian.create_archive ppf  (List.rev !objfiles)
                                    (extract_output !output_name)
     end
     else if !make_package then begin
       Compile.init_path();
-      let exctracted_output = extract_output !output_name in 
-      let revd = List.rev !objfiles in 
-      Bytepackager.package_files (revd)
+      let exctracted_output = extract_output !output_name in
+      let revd = List.rev !objfiles in
+      Bytepackager.package_files ppf (revd)
         (exctracted_output)
     end
     else if not !compile_only && !objfiles <> [] then begin
@@ -198,11 +200,11 @@ let main () =
           default_output !output_name
       in
       Compile.init_path();
-      Bytelink.link (List.rev !objfiles) target
+      Bytelink.link ppf (List.rev !objfiles) target
     end;
     exit 0
   with x ->
-    Errors.report_error Format.err_formatter x;
+    Errors.report_error ppf x;
     exit 2
 
 let _ = main ()
diff --git a/driver/main_args.ml b/driver/main_args.ml
index 326c63e82f..968fe82af8 100644
--- a/driver/main_args.ml
+++ b/driver/main_args.ml
@@ -217,6 +217,10 @@ let mk_S f =
   "-S", Arg.Unit f, " Keep intermediate assembly file"
 ;;
 
+let mk_stdin f =
+  "-stdin", Arg.Unit f, " Read script from standard input"
+;;
+
 let mk_strict_sequence f =
   "-strict-sequence", Arg.Unit f,
   " Left-hand part of a sequence must have type unit"
@@ -449,6 +453,7 @@ module type Bytetop_options = sig
   val _nostdlib : unit -> unit
   val _principal : unit -> unit
   val _rectypes : unit -> unit
+  val _stdin: unit -> unit
   val _strict_sequence : unit -> unit
   val _unsafe : unit -> unit
   val _version : unit -> unit
@@ -549,6 +554,7 @@ module type Opttop_options = sig
   val _principal : unit -> unit
   val _rectypes : unit -> unit
   val _S : unit -> unit
+  val _stdin : unit -> unit
   val _strict_sequence : unit -> unit
   val _unsafe : unit -> unit
   val _version : unit -> unit
@@ -661,6 +667,7 @@ struct
     mk_nostdlib F._nostdlib;
     mk_principal F._principal;
     mk_rectypes F._rectypes;
+    mk_stdin F._stdin;
     mk_strict_sequence F._strict_sequence;
     mk_unsafe F._unsafe;
     mk_version F._version;
@@ -766,6 +773,7 @@ module Make_opttop_options (F : Opttop_options) = struct
     mk_principal F._principal;
     mk_rectypes F._rectypes;
     mk_S F._S;
+    mk_stdin F._stdin;
     mk_strict_sequence F._strict_sequence;
     mk_unsafe F._unsafe;
     mk_version F._version;
diff --git a/driver/main_args.mli b/driver/main_args.mli
index ff284a985a..2249ab20c7 100644
--- a/driver/main_args.mli
+++ b/driver/main_args.mli
@@ -83,6 +83,7 @@ module type Bytetop_options = sig
   val _nostdlib : unit -> unit
   val _principal : unit -> unit
   val _rectypes : unit -> unit
+  val _stdin : unit -> unit
   val _strict_sequence : unit -> unit
   val _unsafe : unit -> unit
   val _version : unit -> unit
@@ -183,6 +184,7 @@ module type Opttop_options = sig
   val _principal : unit -> unit
   val _rectypes : unit -> unit
   val _S : unit -> unit
+  val _stdin : unit -> unit
   val _strict_sequence : unit -> unit
   val _unsafe : unit -> unit
   val _version : unit -> unit
diff --git a/emacs/README b/emacs/README
index 708909b635..ea82a9fd47 100644
--- a/emacs/README
+++ b/emacs/README
@@ -1,4 +1,4 @@
-        O'Caml emacs mode, snapshot of $Date$
+        OCaml emacs mode, snapshot of $Date$
 
 The files in this archive define a caml-mode for emacs, for editing
 OCaml and Objective Label programs, as well as an
@@ -13,12 +13,14 @@ Xavier Leroy, extended with indentation by Ian Zimmerman. For details
 see README.itz, which is the README from Ian Zimmerman's package.
 
 To use it, just put the .el files in your emacs load path, and add the
-following three lines in your .emacs.
+following lines in your .emacs.
 
     (add-to-list 'auto-mode-alist '("\\.ml[iylp]?$" . caml-mode))
-    (autoload 'caml-mode "caml" "Major mode for editing Caml code." t)
-    (autoload 'run-caml "inf-caml" "Run an inferior Caml process." t)
+    (autoload 'caml-mode "caml" "Major mode for editing OCaml code." t)
+    (autoload 'run-caml "inf-caml" "Run an inferior OCaml process." t)
     (autoload 'camldebug "camldebug" "Run ocamldebug on program." t)
+    (add-to-list 'interpreter-mode-alist '("ocamlrun" . caml-mode))
+    (add-to-list 'interpreter-mode-alist '("ocaml" . caml-mode))
 
 or put the .el files in, eg. "/usr/share/emacs/site-lisp/caml-mode/"
 and add the following line in addtion to the four lines above:
diff --git a/emacs/caml-font.el b/emacs/caml-font.el
index 425c07622d..d0eeb5c831 100644
--- a/emacs/caml-font.el
+++ b/emacs/caml-font.el
@@ -338,9 +338,10 @@
     (modify-syntax-entry ?' "w" tbl)
     (modify-syntax-entry ?_ "w" tbl)
     (modify-syntax-entry ?\" "." tbl)
-    (modify-syntax-entry '(?\300 . ?\326) "w" tbl)
-    (modify-syntax-entry '(?\330 . ?\366) "w" tbl)
-    (modify-syntax-entry '(?\370 . ?\377) "w" tbl)
+    (let ((i 192))
+      (while (< i 256)
+        (or (= i 215) (= i 247) (modify-syntax-entry i "w" tbl))
+        (setq i (1+ i))))
     tbl))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
diff --git a/experimental/garrigue/caml_set_oid.diffs b/experimental/garrigue/caml_set_oid.diffs
new file mode 100644
index 0000000000..aaaa160ef4
--- /dev/null
+++ b/experimental/garrigue/caml_set_oid.diffs
@@ -0,0 +1,141 @@
+Index: byterun/intern.c
+===================================================================
+--- byterun/intern.c	(revision 11929)
++++ byterun/intern.c	(working copy)
+@@ -27,6 +27,7 @@
+ #include "memory.h"
+ #include "mlvalues.h"
+ #include "misc.h"
++#include "obj.h"
+ #include "reverse.h"
+ 
+ static unsigned char * intern_src;
+@@ -139,6 +140,14 @@
+         dest = (value *) (intern_dest + 1);
+         *intern_dest = Make_header(size, tag, intern_color);
+         intern_dest += 1 + size;
++        /* For objects, we need to freshen the oid */
++        if (tag == Object_tag) {
++          intern_rec(dest++);
++          intern_rec(dest++);
++          caml_set_oid((value)(dest-2));
++          size -= 2;
++          if (size == 0) return;
++        }
+         for(/*nothing*/; size > 1; size--, dest++)
+           intern_rec(dest);
+         goto tailcall;
+Index: byterun/obj.c
+===================================================================
+--- byterun/obj.c	(revision 11929)
++++ byterun/obj.c	(working copy)
+@@ -25,6 +25,7 @@
+ #include "minor_gc.h"
+ #include "misc.h"
+ #include "mlvalues.h"
++#include "obj.h"
+ #include "prims.h"
+ 
+ CAMLprim value caml_static_alloc(value size)
+@@ -212,6 +213,16 @@
+   return (tag == Field(meths,li) ? Field (meths, li-1) : 0);
+ }
+ 
++/* Generate ids on the C side, to avoid races */
++
++CAMLprim value caml_set_oid (value obj)
++{
++  static value last_oid = 1;
++  Field(obj,1) = last_oid;
++  last_oid += 2;
++  return obj;
++}
++
+ /* these two functions might be useful to an hypothetical JIT */
+ 
+ #ifdef CAML_JIT
+Index: byterun/obj.h
+===================================================================
+--- byterun/obj.h	(revision 0)
++++ byterun/obj.h	(revision 0)
+@@ -0,0 +1,28 @@
++/***********************************************************************/
++/*                                                                     */
++/*                                OCaml                                */
++/*                                                                     */
++/*        Jacques Garrigue, projet Cristal, INRIA Rocquencourt         */
++/*                                                                     */
++/*  Copyright 1996 Institut National de Recherche en Informatique et   */
++/*  en Automatique.  All rights reserved.  This file is distributed    */
++/*  under the terms of the GNU Library General Public License, with    */
++/*  the special exception on linking described in file ../LICENSE.     */
++/*                                                                     */
++/***********************************************************************/
++
++/* $Id$ */
++
++/* Primitives for the Obj and CamlinternalOO modules */
++
++#ifndef CAML_OBJ_H
++#define CAML_OBJ_H
++
++#include "misc.h"
++#include "mlvalues.h"
++
++/* Set the OID of an object to a fresh value */
++/* returns the same object as result */
++value caml_set_oid (value obj);
++
++#endif /* CAML_OBJ_H */
+Index: stdlib/camlinternalOO.ml
+===================================================================
+--- stdlib/camlinternalOO.ml	(revision 11929)
++++ stdlib/camlinternalOO.ml	(working copy)
+@@ -15,23 +15,15 @@
+ 
+ open Obj
+ 
+-(**** Object representation ****)
++(**** OID handling ****)
+ 
+-let last_id = ref 0
+-let new_id () =
+-  let id = !last_id in incr last_id; id
++external set_oid : t -> t = "caml_set_oid" "noalloc"
+ 
+-let set_id o id =
+-  let id0 = !id in
+-  Array.unsafe_set (Obj.magic o : int array) 1 id0;
+-  id := id0 + 1
+-
+ (**** Object copy ****)
+ 
+ let copy o =
+-  let o = (Obj.obj (Obj.dup (Obj.repr o))) in
+-  set_id o last_id;
+-  o
++  let o =  Obj.dup (Obj.repr o) in
++  Obj.obj (set_oid o)
+ 
+ (**** Compression options ****)
+ (* Parameters *)
+@@ -355,8 +347,7 @@
+   let obj = Obj.new_block Obj.object_tag table.size in
+   (* XXX Appel de [caml_modify] *)
+   Obj.set_field obj 0 (Obj.repr table.methods);
+-  set_id obj last_id;
+-  (Obj.obj obj)
++  Obj.obj (set_oid obj)
+ 
+ let create_object_opt obj_0 table =
+   if (Obj.magic obj_0 : bool) then obj_0 else begin
+@@ -364,8 +355,7 @@
+     let obj = Obj.new_block Obj.object_tag table.size in
+     (* XXX Appel de [caml_modify] *)
+     Obj.set_field obj 0 (Obj.repr table.methods);
+-    set_id obj last_id;
+-    (Obj.obj obj)
++    Obj.obj (set_oid obj)
+   end
+ 
+ let rec iter_f obj =
diff --git a/experimental/garrigue/parser-lessminus.diffs b/experimental/garrigue/parser-lessminus.diffs
new file mode 100644
index 0000000000..7b535307c6
--- /dev/null
+++ b/experimental/garrigue/parser-lessminus.diffs
@@ -0,0 +1,77 @@
+Index: parsing/parser.mly
+===================================================================
+--- parsing/parser.mly	(revision 11929)
++++ parsing/parser.mly	(working copy)
+@@ -319,6 +319,11 @@
+   let polyvars, core_type = varify_constructors newtypes core_type in
+   (exp, ghtyp(Ptyp_poly(polyvars,core_type)))
+ 
++let no_lessminus =
++  List.map (fun (p,e,b) ->
++    match b with None -> (p,e)
++    | Some loc -> raise (Syntaxerr.Error (Syntaxerr.Other loc)))
++
+ %}
+ 
+ /* Tokens */
+@@ -597,8 +602,9 @@
+ structure_item:
+     LET rec_flag let_bindings
+       { match $3 with
+-          [{ ppat_desc = Ppat_any; ppat_loc = _ }, exp] -> mkstr(Pstr_eval exp)
+-        | _ -> mkstr(Pstr_value($2, List.rev $3)) }
++          [{ ppat_desc = Ppat_any; ppat_loc = _ }, exp, None] ->
++            mkstr(Pstr_eval exp)
++        | _ -> mkstr(Pstr_value($2, no_lessminus (List.rev $3))) }
+   | EXTERNAL val_ident COLON core_type EQUAL primitive_declaration
+       { mkstr(Pstr_primitive($2, {pval_type = $4; pval_prim = $6})) }
+   | TYPE type_declarations
+@@ -744,7 +750,7 @@
+   | class_simple_expr simple_labeled_expr_list
+       { mkclass(Pcl_apply($1, List.rev $2)) }
+   | LET rec_flag let_bindings IN class_expr
+-      { mkclass(Pcl_let ($2, List.rev $3, $5)) }
++      { mkclass(Pcl_let ($2, no_lessminus (List.rev $3), $5)) }
+ ;
+ class_simple_expr:
+     LBRACKET core_type_comma_list RBRACKET class_longident
+@@ -981,9 +987,15 @@
+   | simple_expr simple_labeled_expr_list
+       { mkexp(Pexp_apply($1, List.rev $2)) }
+   | LET rec_flag let_bindings IN seq_expr
+-      { mkexp(Pexp_let($2, List.rev $3, $5)) }
++      { match $3 with
++        | [pat, expr, Some loc] when $2 = Nonrecursive ->
++            mkexp(Pexp_apply(
++              {pexp_desc = Pexp_ident(Lident "bind"); pexp_loc = loc},
++              ["", expr;  "", ghexp(Pexp_function("", None, [pat, $5]))]))
++        | bindings ->
++            mkexp(Pexp_let($2, no_lessminus (List.rev $3), $5)) }
+   | LET DOT simple_expr let_binding IN seq_expr
+-      { let (pat, expr) = $4 in
++      { let (pat, expr, _) = $4 in
+         mkexp(Pexp_apply($3, ["", expr;  "", ghexp(Pexp_function("", None, [pat, $6]))])) }
+   | LET MODULE UIDENT module_binding IN seq_expr
+       { mkexp(Pexp_letmodule($3, $4, $6)) }
+@@ -1197,14 +1209,17 @@
+ ;
+ let_binding:
+     val_ident fun_binding
+-      { (mkpatvar $1 1, $2) }
++      { (mkpatvar $1 1, $2, None) }
+   | val_ident COLON typevar_list DOT core_type EQUAL seq_expr
+-      { (ghpat(Ppat_constraint(mkpatvar $1 1, ghtyp(Ptyp_poly($3,$5)))), $7) }
++      { (ghpat(Ppat_constraint(mkpatvar $1 1, ghtyp(Ptyp_poly($3,$5)))), $7,
++        None) }
+   | val_ident COLON TYPE lident_list DOT core_type EQUAL seq_expr
+       { let exp, poly = wrap_type_annotation $4 $6 $8 in
+-        (ghpat(Ppat_constraint(mkpatvar $1 1, poly)), exp) }
++        (ghpat(Ppat_constraint(mkpatvar $1 1, poly)), exp, None) }
+   | pattern EQUAL seq_expr
+-      { ($1, $3) }
++      { ($1, $3, None) }
++  | pattern LESSMINUS seq_expr
++      { ($1, $3, Some (rhs_loc 2)) }
+ ;
+ fun_binding:
+     strict_binding
diff --git a/experimental/garrigue/with-module-type.diffs b/experimental/garrigue/with-module-type.diffs
new file mode 100644
index 0000000000..c955b1f866
--- /dev/null
+++ b/experimental/garrigue/with-module-type.diffs
@@ -0,0 +1,182 @@
+Index: parsing/parser.mly
+===================================================================
+--- parsing/parser.mly	(revision 12005)
++++ parsing/parser.mly	(working copy)
+@@ -1504,6 +1504,10 @@
+       { ($2, Pwith_module $4) }
+   | MODULE mod_longident COLONEQUAL mod_ext_longident
+       { ($2, Pwith_modsubst $4) }
++  | MODULE TYPE mod_longident EQUAL module_type
++      { ($3, Pwith_modtype $5) }
++  | MODULE TYPE mod_longident COLONEQUAL module_type
++      { ($3, Pwith_modtypesubst $5) }
+ ;
+ with_type_binder:
+     EQUAL          { Public }
+Index: parsing/parsetree.mli
+===================================================================
+--- parsing/parsetree.mli	(revision 12005)
++++ parsing/parsetree.mli	(working copy)
+@@ -239,6 +239,8 @@
+   | Pwith_module of Longident.t
+   | Pwith_typesubst of type_declaration
+   | Pwith_modsubst of Longident.t
++  | Pwith_modtype of module_type
++  | Pwith_modtypesubst of module_type
+ 
+ (* Value expressions for the module language *)
+ 
+Index: parsing/printast.ml
+===================================================================
+--- parsing/printast.ml	(revision 12005)
++++ parsing/printast.ml	(working copy)
+@@ -575,6 +575,12 @@
+       type_declaration (i+1) ppf td;
+   | Pwith_module (li) -> line i ppf "Pwith_module %a\n" fmt_longident li;
+   | Pwith_modsubst (li) -> line i ppf "Pwith_modsubst %a\n" fmt_longident li;
++  | Pwith_modtype (mty) ->
++      line i ppf "Pwith_modtype\n";
++      module_type (i+1) ppf mty;
++  | Pwith_modtypesubst (mty) ->
++      line i ppf "Pwith_modtype\n";
++      module_type (i+1) ppf mty;
+ 
+ and module_expr i ppf x =
+   line i ppf "module_expr %a\n" fmt_location x.pmod_loc;
+Index: typing/typemod.ml
+===================================================================
+--- typing/typemod.ml	(revision 12005)
++++ typing/typemod.ml	(working copy)
+@@ -74,6 +74,8 @@
+   : (Env.t -> Parsetree.module_expr -> module_type) ref
+   = ref (fun env m -> assert false)
+ 
++let transl_modtype_fwd = ref (fun env m -> assert false)
++
+ (* Merge one "with" constraint in a signature *)
+ 
+ let rec add_rec_types env = function
+@@ -163,6 +165,19 @@
+         ignore(Includemod.modtypes env newmty mty);
+         real_id := Some id;
+         make_next_first rs rem
++    | (Tsig_modtype(id, mtd) :: rem, [s], Pwith_modtype pmty)
++      when Ident.name id = s ->
++        let mty = !transl_modtype_fwd initial_env pmty in
++        let mtd' = Tmodtype_manifest mty in
++        Includemod.modtype_declarations env id mtd' mtd;
++        Tsig_modtype(id, mtd') :: rem
++    | (Tsig_modtype(id, mtd) :: rem, [s], Pwith_modtypesubst pmty)
++      when Ident.name id = s ->
++        let mty = !transl_modtype_fwd initial_env pmty in
++        let mtd' = Tmodtype_manifest mty in
++        Includemod.modtype_declarations env id mtd' mtd;
++        real_id := Some id;
++        rem
+     | (Tsig_module(id, mty, rs) :: rem, s :: namelist, _)
+       when Ident.name id = s ->
+         let newsg = merge env (extract_sig env loc mty) namelist None in
+@@ -200,6 +215,12 @@
+         let (path, _) = Typetexp.find_module initial_env loc lid in
+         let sub = Subst.add_module id path Subst.identity in
+         Subst.signature sub sg
++    | [s], Pwith_modtypesubst pmty ->
++        let id =
++          match !real_id with None -> assert false | Some id -> id in
++        let mty = !transl_modtype_fwd initial_env pmty in
++        let sub = Subst.add_modtype id mty Subst.identity in
++        Subst.signature sub sg
+     | _ ->
+         sg
+   with Includemod.Error explanation ->
+@@ -499,6 +520,8 @@
+   check_recmod_typedecls env2 sdecls dcl2;
+   (dcl2, env2)
+ 
++let () = transl_modtype_fwd := transl_modtype
++
+ (* Try to convert a module expression to a module path. *)
+ 
+ exception Not_a_path
+Index: typing/includemod.ml
+===================================================================
+--- typing/includemod.ml	(revision 12005)
++++ typing/includemod.ml	(working copy)
+@@ -326,10 +326,10 @@
+ 
+ (* Hide the context and substitution parameters to the outside world *)
+ 
+-let modtypes env mty1 mty2 = modtypes env [] Subst.identity mty1 mty2
+-let signatures env sig1 sig2 = signatures env [] Subst.identity sig1 sig2
+-let type_declarations env id decl1 decl2 =
+-  type_declarations env [] Subst.identity id decl1 decl2
++let modtypes env = modtypes env [] Subst.identity
++let signatures env = signatures env [] Subst.identity
++let type_declarations env = type_declarations env [] Subst.identity
++let modtype_declarations env = modtype_infos env [] Subst.identity
+ 
+ (* Error report *)
+ 
+Index: typing/includemod.mli
+===================================================================
+--- typing/includemod.mli	(revision 12005)
++++ typing/includemod.mli	(working copy)
+@@ -23,6 +23,8 @@
+ val compunit: string -> signature -> string -> signature -> module_coercion
+ val type_declarations:
+       Env.t -> Ident.t -> type_declaration -> type_declaration -> unit
++val modtype_declarations:
++      Env.t -> Ident.t -> modtype_declaration -> modtype_declaration -> unit
+ 
+ type symptom =
+     Missing_field of Ident.t
+Index: testsuite/tests/typing-modules/Test.ml.reference
+===================================================================
+--- testsuite/tests/typing-modules/Test.ml.reference	(revision 12005)
++++ testsuite/tests/typing-modules/Test.ml.reference	(working copy)
+@@ -6,4 +6,12 @@
+ #       type -'a t
+ class type c = object method m : [ `A ] t end
+ #   module M : sig val v : (#c as 'a) -> 'a end
++#       module type S = sig module type T module F : functor (X : T) -> T end
++# module type T0 = sig type t end
++# module type S1 = sig module type T = T0 module F : functor (X : T) -> T end
++# module type S2 = sig module F : functor (X : T0) -> T0 end
++# module type S3 =
++  sig
++    module F : functor (X : sig type t = int end) -> sig type t = int end
++  end
+ # 
+Index: testsuite/tests/typing-modules/Test.ml.principal.reference
+===================================================================
+--- testsuite/tests/typing-modules/Test.ml.principal.reference	(revision 12005)
++++ testsuite/tests/typing-modules/Test.ml.principal.reference	(working copy)
+@@ -6,4 +6,12 @@
+ #       type -'a t
+ class type c = object method m : [ `A ] t end
+ #   module M : sig val v : (#c as 'a) -> 'a end
++#       module type S = sig module type T module F : functor (X : T) -> T end
++# module type T0 = sig type t end
++# module type S1 = sig module type T = T0 module F : functor (X : T) -> T end
++# module type S2 = sig module F : functor (X : T0) -> T0 end
++# module type S3 =
++  sig
++    module F : functor (X : sig type t = int end) -> sig type t = int end
++  end
+ # 
+Index: testsuite/tests/typing-modules/Test.ml
+===================================================================
+--- testsuite/tests/typing-modules/Test.ml	(revision 12005)
++++ testsuite/tests/typing-modules/Test.ml	(working copy)
+@@ -9,3 +9,11 @@
+ class type c = object method m : [ `A ] t end;;
+ module M : sig val v : (#c as 'a) -> 'a end =
+   struct let v x = ignore (x :> c); x end;;
++
++(* with module type *)
++
++module type S = sig module type T module F(X:T) : T end;;
++module type T0 = sig type t end;;
++module type S1 = S with module type T = T0;;
++module type S2 = S with module type T := T0;;
++module type S3 = S with module type T := sig type t = int end;;
diff --git a/myocamlbuild.ml b/myocamlbuild.ml
index 449fc59c81..a95db6f3ab 100644
--- a/myocamlbuild.ml
+++ b/myocamlbuild.ml
@@ -1046,7 +1046,7 @@ rule "labltk"
   ~prod:"otherlibs/labltk/lib/labltk"
   begin fun _ _ ->
     Echo(["#!/bin/sh\n";
-          Printf.sprintf "exec %s -I %s $*\n" (labltk_installdir/"labltktop") labltk_installdir],
+          Printf.sprintf "exec %s -I %s \"$@\"\n" (labltk_installdir/"labltktop") labltk_installdir],
          "otherlibs/labltk/lib/labltk")
   end;;
 
diff --git a/myocamlbuild_config.mli b/myocamlbuild_config.mli
index 3345a5701b..5eec980326 100644
--- a/myocamlbuild_config.mli
+++ b/myocamlbuild_config.mli
@@ -16,6 +16,7 @@ val libdir : string
 val manext : string
 val ranlib : string
 val ranlibcmd : string
+val arcmd : string
 val sharpbangscripts : bool
 val bng_arch : string
 val bng_asm_level : string
diff --git a/ocamlbuild/_tags b/ocamlbuild/_tags
index cd271d16f5..cf63d89276 100644
--- a/ocamlbuild/_tags
+++ b/ocamlbuild/_tags
@@ -16,7 +16,7 @@ true: debug
 "discard_printf.ml": rectypes
 "ocamlbuildlib.cma" or "ocamlbuildlightlib.cma": linkall
 <*.byte> or <*.native> or <*.top>: use_unix
-"ocamlbuildlight.byte": -use_unix
+"ocamlbuildlight.byte": -use_unix, nopervasives
 <*.cmx>: for-pack(Ocamlbuild_pack)
 <{ocamlbuild_{pack,unix_plugin,plugin,executor},ppcache}{,.p}.cmx>: -for-pack(Ocamlbuild_pack)
 "doc": not_hygienic
diff --git a/ocamldoc/odoc_ast.ml b/ocamldoc/odoc_ast.ml
index c497794184..f436e646cf 100644
--- a/ocamldoc/odoc_ast.ml
+++ b/ocamldoc/odoc_ast.ml
@@ -644,10 +644,6 @@ module Analyser =
             (* don't give a $*%@ ! *)
             iter acc_inher acc_fields loc.Location.loc_end.Lexing.pos_cnum q
 
-        | Parsetree.Pcf_let (_, _, loc) :: q ->
-            (* don't give a $*%@ ! *)
-            iter acc_inher acc_fields loc.Location.loc_end.Lexing.pos_cnum q
-
         | (Parsetree.Pcf_init exp) :: q ->
             iter acc_inher acc_fields exp.Parsetree.pexp_loc.Location.loc_end.Lexing.pos_cnum q
       in
diff --git a/otherlibs/labltk/browser/searchpos.ml b/otherlibs/labltk/browser/searchpos.ml
index f6fb50051b..78087c80d9 100644
--- a/otherlibs/labltk/browser/searchpos.ml
+++ b/otherlibs/labltk/browser/searchpos.ml
@@ -693,13 +693,6 @@ and search_pos_class_structure ~pos cls =
       | Cf_val (_, _, Some exp, _) -> search_pos_expr exp ~pos
       | Cf_val _ -> ()
       | Cf_meth (_, exp) -> search_pos_expr exp ~pos
-      | Cf_let (_, pel, iel) ->
-          List.iter pel ~f:
-            begin fun (pat, exp) ->
-              search_pos_pat pat ~pos ~env:exp.exp_env;
-              search_pos_expr exp ~pos
-            end;
-          List.iter iel ~f:(fun (_,exp) -> search_pos_expr exp ~pos)
       | Cf_init exp -> search_pos_expr exp ~pos
     end
 
diff --git a/otherlibs/labltk/lib/Makefile b/otherlibs/labltk/lib/Makefile
index 6be9af0560..35ba8ff680 100644
--- a/otherlibs/labltk/lib/Makefile
+++ b/otherlibs/labltk/lib/Makefile
@@ -71,7 +71,7 @@ $(LIBNAME)top$(EXE) : $(TOPDEPS) $(LIBNAME).cma ../support/lib$(LIBNAME).$(A)
 $(LIBNAME): Makefile $(TOPDIR)/config/Makefile
 	@echo Generate $@
 	@echo "#!/bin/sh" > $@
-	@echo 'exec $(INSTALLDIR)/$(LIBNAME)top$(EXE) -I $(INSTALLDIR) $$*' >> $@
+	@echo 'exec $(INSTALLDIR)/$(LIBNAME)top$(EXE) -I $(INSTALLDIR) "$$@"' >> $@
 
 install-script: $(LIBNAME)
 	cp $(LIBNAME) $(BINDIR)
diff --git a/otherlibs/num/Makefile.nt b/otherlibs/num/Makefile.nt
index 9d831657af..4ac69c7cad 100644
--- a/otherlibs/num/Makefile.nt
+++ b/otherlibs/num/Makefile.nt
@@ -28,7 +28,7 @@ clean::
 	rm -f *~
 
 bng.$(O): bng.h bng_digit.c \
-       bng_alpha.c bng_amd64.c bng_ia32.c bng_mips.c bng_ppc.c bng_sparc.c
+       bng_amd64.c bng_ia32.c bng_ppc.c bng_sparc.c
 
 depend:
 	sed -e 's/\.o/.$(O)/g' .depend > .depend.nt
diff --git a/otherlibs/num/num.mli b/otherlibs/num/num.mli
index 1d421ff29d..1773338470 100644
--- a/otherlibs/num/num.mli
+++ b/otherlibs/num/num.mli
@@ -155,7 +155,9 @@ val approx_num_exp : int -> num -> string
    first argument is the number of digits in the mantissa. *)
 
 val num_of_string : string -> num
-(** Convert a string to a number. *)
+(** Convert a string to a number.
+   Raise [Failure "num_of_string"] if the given string is not
+   a valid representation of an integer *)
 
 (** {6 Coercions between numerical types} *)
 
diff --git a/otherlibs/unix/unixsupport.c b/otherlibs/unix/unixsupport.c
index 3138115a6f..4c91adb104 100644
--- a/otherlibs/unix/unixsupport.c
+++ b/otherlibs/unix/unixsupport.c
@@ -165,7 +165,11 @@
 #define ESOCKTNOSUPPORT (-1)
 #endif
 #ifndef EOPNOTSUPP
-#define EOPNOTSUPP (-1)
+#  ifdef ENOTSUP
+#    define EOPNOTSUPP ENOTSUP
+#  else
+#    define EOPNOTSUPP (-1)
+#  endif
 #endif
 #ifndef EPFNOSUPPORT
 #define EPFNOSUPPORT (-1)
@@ -252,6 +256,11 @@ value unix_error_of_code (int errcode)
   int errconstr;
   value err;
 
+#if defined(ENOTSUP) && (EOPNOTSUPP != ENOTSUP)
+  if (errcode == ENOTSUP)
+    errcode = EOPNOTSUPP;
+#endif
+
   errconstr =
       cst_to_constr(errcode, error_table, sizeof(error_table)/sizeof(int), -1);
   if (errconstr == Val_int(-1)) {
diff --git a/otherlibs/win32unix/Makefile.nt b/otherlibs/win32unix/Makefile.nt
index 80fcbf35b7..84f1574a34 100644
--- a/otherlibs/win32unix/Makefile.nt
+++ b/otherlibs/win32unix/Makefile.nt
@@ -21,7 +21,7 @@ WIN_FILES = accept.c bind.c channels.c close.c \
   mkdir.c open.c pipe.c read.c rename.c \
   select.c sendrecv.c \
   shutdown.c sleep.c socket.c sockopt.c startup.c stat.c \
-  system.c unixsupport.c windir.c winwait.c write.c \
+  system.c times.c unixsupport.c windir.c winwait.c write.c \
   winlist.c winworker.c windbug.c
 
 # Files from the ../unix directory
diff --git a/otherlibs/win32unix/accept.c b/otherlibs/win32unix/accept.c
index 48d028790f..68c7bac7af 100644
--- a/otherlibs/win32unix/accept.c
+++ b/otherlibs/win32unix/accept.c
@@ -26,30 +26,15 @@ CAMLprim value unix_accept(sock)
   SOCKET sconn = Socket_val(sock);
   SOCKET snew;
   value fd = Val_unit, adr = Val_unit, res;
-  int oldvalue, oldvaluelen, newvalue, retcode;
   union sock_addr_union addr;
   socklen_param_type addr_len;
   DWORD err = 0;
 
-  oldvaluelen = sizeof(oldvalue);
-  retcode = getsockopt(INVALID_SOCKET, SOL_SOCKET, SO_OPENTYPE,
-                       (char *) &oldvalue, &oldvaluelen);
-  if (retcode == 0) {
-    /* Set sockets to synchronous mode */
-    newvalue = SO_SYNCHRONOUS_NONALERT;
-    setsockopt(INVALID_SOCKET, SOL_SOCKET, SO_OPENTYPE,
-               (char *) &newvalue, sizeof(newvalue));
-  }
   addr_len = sizeof(sock_addr);
   enter_blocking_section();
   snew = accept(sconn, &addr.s_gen, &addr_len);
   if (snew == INVALID_SOCKET) err = WSAGetLastError ();
   leave_blocking_section();
-  if (retcode == 0) {
-    /* Restore initial mode */
-    setsockopt(INVALID_SOCKET, SOL_SOCKET, SO_OPENTYPE,
-               (char *) &oldvalue, oldvaluelen);
-  }
   if (snew == INVALID_SOCKET) {
     win32_maperr(err);
     uerror("accept", Nothing);
diff --git a/otherlibs/win32unix/channels.c b/otherlibs/win32unix/channels.c
index 2a3774d90e..ea3912720d 100644
--- a/otherlibs/win32unix/channels.c
+++ b/otherlibs/win32unix/channels.c
@@ -20,15 +20,15 @@
 #include "unixsupport.h"
 #include <fcntl.h>
 
-extern long _get_osfhandle(int);
-extern int _open_osfhandle(long, int);
+extern intptr_t _get_osfhandle(int);
+extern int _open_osfhandle(intptr_t, int);
 
 int win_CRT_fd_of_filedescr(value handle)
 {
   if (CRT_fd_val(handle) != NO_CRT_FD) {
     return CRT_fd_val(handle);
   } else {
-    int fd = _open_osfhandle((long) Handle_val(handle), O_BINARY);
+    int fd = _open_osfhandle((intptr_t) Handle_val(handle), O_BINARY);
     if (fd == -1) uerror("channel_of_descr", Nothing);
     CRT_fd_val(handle) = fd;
     return fd;
diff --git a/otherlibs/win32unix/select.c b/otherlibs/win32unix/select.c
index af9766ff87..7069d140fb 100644
--- a/otherlibs/win32unix/select.c
+++ b/otherlibs/win32unix/select.c
@@ -114,9 +114,9 @@ typedef enum _SELECTHANDLETYPE {
 
 typedef enum _SELECTMODE {
   SELECT_MODE_NONE = 0,
-  SELECT_MODE_READ,
-  SELECT_MODE_WRITE, 
-  SELECT_MODE_EXCEPT,
+  SELECT_MODE_READ = 1,
+  SELECT_MODE_WRITE = 2, 
+  SELECT_MODE_EXCEPT = 4,
 } SELECTMODE;
 
 typedef enum _SELECTSTATE {
@@ -157,7 +157,9 @@ typedef SELECTQUERY *LPSELECTQUERY;
 typedef struct _SELECTDATA {
   LIST             lst;
   SELECTTYPE       EType;
-  SELECTRESULT     aResults[MAXIMUM_SELECT_OBJECTS];
+  /* Sockets may generate a result for all three lists from one single query object
+   */
+  SELECTRESULT     aResults[MAXIMUM_SELECT_OBJECTS * 3];
   DWORD            nResultsCount;
   /* Data following are dedicated to APC like call, they
      will be initialized if required.
@@ -240,7 +242,7 @@ DWORD select_data_result_add (LPSELECTDATA lpSelectData, SELECTMODE EMode, int l
   DWORD i;
 
   res = 0;
-  if (lpSelectData->nResultsCount < MAXIMUM_SELECT_OBJECTS)
+  if (lpSelectData->nResultsCount < MAXIMUM_SELECT_OBJECTS * 3)
   {
     i = lpSelectData->nResultsCount;
     lpSelectData->aResults[i].EMode  = EMode;
@@ -490,31 +492,38 @@ LPSELECTDATA read_pipe_poll_add (LPSELECTDATA lpSelectData,
 void socket_poll (HANDLE hStop, void *_data)
 {
   LPSELECTDATA   lpSelectData;
-  LPSELECTQUERY  iterQuery;
-  HANDLE         aEvents[MAXIMUM_SELECT_OBJECTS];
-  DWORD          nEvents;
-  long           maskEvents;
-  DWORD          i;
-  u_long         iMode;
+  LPSELECTQUERY    iterQuery;
+  HANDLE           aEvents[MAXIMUM_SELECT_OBJECTS];
+  DWORD            nEvents;
+  long             maskEvents;
+  DWORD            i;
+  u_long           iMode;
+  SELECTMODE       mode;
+  WSANETWORKEVENTS events;
 
   lpSelectData = (LPSELECTDATA)_data;
 
+  DEBUG_PRINT("Worker has %d queries to service", lpSelectData->nQueriesCount);
   for (nEvents = 0; nEvents < lpSelectData->nQueriesCount; nEvents++)
   {
     iterQuery = &(lpSelectData->aQueries[nEvents]);
     aEvents[nEvents] = CreateEvent(NULL, TRUE, FALSE, NULL);
     maskEvents = 0;
-    switch (iterQuery->EMode)
+    mode = iterQuery->EMode;
+    if ((mode & SELECT_MODE_READ) != 0)
     {
-      case SELECT_MODE_READ:
-        maskEvents = FD_READ | FD_ACCEPT | FD_CLOSE;
-        break;
-      case SELECT_MODE_WRITE:
-        maskEvents = FD_WRITE | FD_CONNECT | FD_CLOSE;
-        break;
-      case SELECT_MODE_EXCEPT:
-        maskEvents = FD_OOB;
-        break;
+      DEBUG_PRINT("Polling read for %d", iterQuery->hFileDescr);
+      maskEvents |= FD_READ | FD_ACCEPT | FD_CLOSE;
+    }
+    if ((mode & SELECT_MODE_WRITE) != 0)
+    {
+      DEBUG_PRINT("Polling write for %d", iterQuery->hFileDescr);
+      maskEvents |= FD_WRITE | FD_CONNECT | FD_CLOSE;
+    }
+    if ((mode & SELECT_MODE_EXCEPT) != 0)
+    {
+      DEBUG_PRINT("Polling exceptions for %d", iterQuery->hFileDescr);
+      maskEvents |= FD_OOB;
     }
 
     check_error(lpSelectData,
@@ -548,7 +557,23 @@ void socket_poll (HANDLE hStop, void *_data)
         DEBUG_PRINT("Socket %d has pending events", (i - 1));
         if (iterQuery != NULL)
         {
-          select_data_result_add(lpSelectData, iterQuery->EMode, iterQuery->lpOrigIdx);
+          /* Find out what kind of events were raised
+           */
+          if (WSAEnumNetworkEvents((SOCKET)(iterQuery->hFileDescr), aEvents[i], &events) == 0)
+          {
+            if ((iterQuery->EMode & SELECT_MODE_READ) != 0 && (events.lNetworkEvents & (FD_READ | FD_ACCEPT | FD_CLOSE)) != 0)
+            {
+              select_data_result_add(lpSelectData, SELECT_MODE_READ, iterQuery->lpOrigIdx);
+            }
+            if ((iterQuery->EMode & SELECT_MODE_WRITE) != 0 && (events.lNetworkEvents & (FD_WRITE | FD_CONNECT | FD_CLOSE)) != 0)
+            {
+              select_data_result_add(lpSelectData, SELECT_MODE_WRITE, iterQuery->lpOrigIdx);
+            }
+            if ((iterQuery->EMode & SELECT_MODE_EXCEPT) != 0 && (events.lNetworkEvents & FD_OOB) != 0)
+            {
+              select_data_result_add(lpSelectData, SELECT_MODE_EXCEPT, iterQuery->lpOrigIdx);
+            }
+          }
         }
       }
       /* WSAEventSelect() automatically sets socket to nonblocking mode.
@@ -581,23 +606,88 @@ LPSELECTDATA socket_poll_add (LPSELECTDATA lpSelectData,
                               unsigned int uFlagsFd)
 {
   LPSELECTDATA res;
-  LPSELECTDATA hd;
+  LPSELECTDATA candidate;
+  DWORD i;
+  LPSELECTQUERY aQueries;
   
-  hd = lpSelectData;
+  res = lpSelectData;
+  candidate = NULL;
+  aQueries = NULL;
+
   /* Polling socket can be done mulitple handle at the same time. You just
      need one worker to use it. Try to find if there is already a worker
      handling this kind of request.
+     Only one event can be associated with a given socket which means that if a socket
+     is in more than one of the fd_sets then we have to find that particular query and update
+     EMode with the additional flag.
      */
   DEBUG_PRINT("Scanning list of worker to find one that already handle socket");
-  res = select_data_job_search(&hd, SELECT_TYPE_SOCKET);
-  
-  /* Add a new socket to poll */
-  res->funcWorker = socket_poll;
-  DEBUG_PRINT("Add socket %x to worker", hFileDescr);
-  select_data_query_add(res, EMode, hFileDescr, lpOrigIdx, uFlagsFd);
-  DEBUG_PRINT("Socket %x added", hFileDescr);
+  /* Search for job */
+  DEBUG_PRINT("Searching for an available job for type %d for descriptor %d", SELECT_TYPE_SOCKET, hFileDescr);
+  while (res != NULL)
+  {
+    if (res->EType == SELECT_TYPE_SOCKET)
+    {
+      i = res->nQueriesCount - 1;
+      aQueries = res->aQueries;
+      while (i >= 0 && aQueries[i].hFileDescr != hFileDescr)
+      {
+        i--;
+      }
+      /* If we didn't find the socket but this worker has available slots, store it
+       */
+      if (i < 0)
+      {
+        if ( res->nQueriesCount < MAXIMUM_SELECT_OBJECTS)
+        {
+          candidate = res;
+        }
+        res = LIST_NEXT(LPSELECTDATA, res);
+      }
+      else
+      {
+        /* Previous socket query located -- we're finished
+         */
+        aQueries = &aQueries[i];
+        break;
+      }
+    }
+    else
+    {
+      res = LIST_NEXT(LPSELECTDATA, res);
+    }
+  }
 
-  return hd;
+  if (res == NULL)
+  {
+    res = candidate;
+
+    /* No matching job found, create one */
+    if (res == NULL)
+    {
+      DEBUG_PRINT("No job for type %d found, create one", SELECT_TYPE_SOCKET);
+      res = select_data_new(lpSelectData, SELECT_TYPE_SOCKET);
+      res->funcWorker = socket_poll;
+      res->nQueriesCount = 1;
+      aQueries = &res->aQueries[0];
+    }
+    else
+    {
+      aQueries = &(res->aQueries[res->nQueriesCount++]);
+    }
+    aQueries->EMode = EMode;
+    aQueries->hFileDescr = hFileDescr;
+    aQueries->lpOrigIdx = lpOrigIdx;
+    aQueries->uFlagsFd = uFlagsFd;
+    DEBUG_PRINT("Socket %x added", hFileDescr);
+  }
+  else
+  {
+    aQueries->EMode |= EMode;
+    DEBUG_PRINT("Socket %x updated to %d", hFileDescr, aQueries->EMode);
+  }
+
+  return res;
 }
 
 /***********************/
@@ -817,6 +907,42 @@ static value find_handle(LPSELECTRESULT iterResult, value readfds, value writefd
 
 #define MAX(a, b) ((a) > (b) ? (a) : (b))
 
+/* Convert fdlist to an fd_set if all the handles in fdlist are sockets and return 0.
+ * Returns 1 if a non-socket value is encountered.
+ */
+static int fdlist_to_fdset(value fdlist, fd_set *fdset)
+{
+  value l, c;
+  FD_ZERO(fdset);
+  for (l = fdlist; l != Val_int(0); l = Field(l, 1)) {
+    c = Field(l, 0);
+    if (Descr_kind_val(c) == KIND_SOCKET) {
+      FD_SET(Socket_val(c), fdset);
+    } else {
+      DEBUG_PRINT("Non socket value encountered");
+      return 0;
+    }
+  }
+  return 1;
+}
+
+static value fdset_to_fdlist(value fdlist, fd_set *fdset)
+{
+  value res = Val_int(0);
+  Begin_roots2(fdlist, res)
+    for (/*nothing*/; fdlist != Val_int(0); fdlist = Field(fdlist, 1)) {
+      value s = Field(fdlist, 0);
+      if (FD_ISSET(Socket_val(s), fdset)) {
+        value newres = alloc_small(2, 0);
+        Field(newres, 0) = s;
+        Field(newres, 1) = res;
+        res = newres;
+      }
+    }
+  End_roots();
+  return res;
+}
+
 CAMLprim value unix_select(value readfds, value writefds, value exceptfds, value timeout)
 {  
   /* Event associated to handle */
@@ -860,246 +986,287 @@ CAMLprim value unix_select(value readfds, value writefds, value exceptfds, value
   CAMLlocal5 (read_list, write_list, except_list, res, l);
   CAMLlocal1 (fd);
 
+  fd_set read, write, except;
+  double tm;
+  struct timeval tv;
+  struct timeval * tvp;
+  
   DEBUG_PRINT("in select");
 
-  nEventsCount   = 0;
-  nEventsMax     = 0;
-  lpEventsDone   = NULL;
-  lpSelectData   = NULL;
-  iterSelectData = NULL;
-  iterResult     = NULL;
-  err            = 0;
-  hasStaticData  = 0;
-  waitRet        = 0;
-  readfds_len    = caml_list_length(readfds);
-  writefds_len   = caml_list_length(writefds);
-  exceptfds_len  = caml_list_length(exceptfds);
-  hdsMax         = MAX(readfds_len, MAX(writefds_len, exceptfds_len));
-
-  hdsData = (HANDLE *)caml_stat_alloc(sizeof(HANDLE) * hdsMax);
-
-  if (Double_val(timeout) >= 0.0)
-  {
-    milliseconds = 1000 * Double_val(timeout);
-    DEBUG_PRINT("Will wait %d ms", milliseconds);
-  }
-  else
-  {
-    milliseconds = INFINITE;
-  }
-
-
-  /* Create list of select data, based on the different list of fd to watch */
-  DEBUG_PRINT("Dispatch read fd");
-  handle_set_init(&hds, hdsData, hdsMax);
-  i=0;
-  for (l = readfds; l != Val_int(0); l = Field(l, 1))
-  {
-    fd = Field(l, 0);
-    if (!handle_set_mem(&hds, Handle_val(fd)))
-    {
-      handle_set_add(&hds, Handle_val(fd));
-      lpSelectData = select_data_dispatch(lpSelectData, SELECT_MODE_READ, fd, i++);
-    }
-    else
-    {
-      DEBUG_PRINT("Discarding handle %x which is already monitor for read", Handle_val(fd));
-    }
-  }
-  handle_set_reset(&hds);
-
-  DEBUG_PRINT("Dispatch write fd");
-  handle_set_init(&hds, hdsData, hdsMax);
-  i=0;
-  for (l = writefds; l != Val_int(0); l = Field(l, 1))
-  {
-    fd = Field(l, 0);
-    if (!handle_set_mem(&hds, Handle_val(fd)))
-    {
-      handle_set_add(&hds, Handle_val(fd));
-      lpSelectData = select_data_dispatch(lpSelectData, SELECT_MODE_WRITE, fd, i++);
-    }
-    else
-    {
-      DEBUG_PRINT("Discarding handle %x which is already monitor for write", Handle_val(fd));
+  err = 0;
+  tm = Double_val(timeout);
+  if (readfds == Val_int(0) && writefds == Val_int(0) && exceptfds == Val_int(0)) {
+    DEBUG_PRINT("nothing to do");
+    if ( tm > 0.0 ) {
+      enter_blocking_section();
+      Sleep( (int)(tm * 1000));
+      leave_blocking_section();
     }
-  }
-  handle_set_reset(&hds);
-
-  DEBUG_PRINT("Dispatch exceptional fd");
-  handle_set_init(&hds, hdsData, hdsMax);
-  i=0;
-  for (l = exceptfds; l != Val_int(0); l = Field(l, 1))
-  {
-    fd = Field(l, 0);
-    if (!handle_set_mem(&hds, Handle_val(fd)))
-    {
-      handle_set_add(&hds, Handle_val(fd));
-      lpSelectData = select_data_dispatch(lpSelectData, SELECT_MODE_EXCEPT, fd, i++);
-    }
-    else
-    {
-      DEBUG_PRINT("Discarding handle %x which is already monitor for exceptional", Handle_val(fd));
-    }
-  }
-  handle_set_reset(&hds);
-
-  /* Building the list of handle to wait for */
-  DEBUG_PRINT("Building events done array");
-  nEventsMax   = list_length((LPLIST)lpSelectData);
-  nEventsCount = 0;
-  lpEventsDone = (HANDLE *)caml_stat_alloc(sizeof(HANDLE) * nEventsMax);
-
-  iterSelectData = lpSelectData;
-  while (iterSelectData != NULL)
-  {
-    /* Check if it is static data. If this is the case, launch everything
-     * but don't wait for events. It helps to test if there are events on
-     * any other fd (which are not static), knowing that there is at least
-     * one result (the static data).
-     */
-    if (iterSelectData->EType == SELECT_TYPE_STATIC)
-    {
-      hasStaticData = TRUE;
-    };
-
-    /* Execute APC */
-    if (iterSelectData->funcWorker != NULL)
-    {
-      iterSelectData->lpWorker = 
-        worker_job_submit(
-            iterSelectData->funcWorker, 
-            (void *)iterSelectData);
-      DEBUG_PRINT("Job submitted to worker %x", iterSelectData->lpWorker); 
-      lpEventsDone[nEventsCount] = worker_job_event_done(iterSelectData->lpWorker);
-      nEventsCount++;
-    };
-    iterSelectData = LIST_NEXT(LPSELECTDATA, iterSelectData);
-  };
-
-  DEBUG_PRINT("Need to watch %d workers", nEventsCount);
-
-  /* Processing select itself */
-  enter_blocking_section();
-  /* There are worker started, waiting to be monitored */
-  if (nEventsCount > 0)
-  {
-    /* Waiting for event */
-    if (err == 0 && !hasStaticData)
-    {
-      DEBUG_PRINT("Waiting for one select worker to be done");
-      switch (WaitForMultipleObjects(nEventsCount, lpEventsDone, FALSE, milliseconds))
-      {
-        case WAIT_FAILED:
-          err = GetLastError();
-          break;
-
-        case WAIT_TIMEOUT:
-          DEBUG_PRINT("Select timeout");
-          break;
-
-        default:
-          DEBUG_PRINT("One worker is done");
-          break;
-      };
-    }
-
-    /* Ordering stop to every worker */
-    DEBUG_PRINT("Sending stop signal to every select workers");
-    iterSelectData = lpSelectData;
-    while (iterSelectData != NULL)
-    {
-      if (iterSelectData->lpWorker != NULL)
-      {
-        worker_job_stop(iterSelectData->lpWorker);
-      };
-      iterSelectData = LIST_NEXT(LPSELECTDATA, iterSelectData);
-    };
+    read_list = write_list = except_list = Val_int(0);
+  } else {      
+    if (fdlist_to_fdset(readfds, &read) && fdlist_to_fdset(writefds, &write) && fdlist_to_fdset(exceptfds, &except)) {
+      DEBUG_PRINT("only sockets to select on, using classic select");
+      if (tm < 0.0) {
+        tvp = (struct timeval *) NULL;
+      } else {
+        tv.tv_sec = (int) tm;
+        tv.tv_usec = (int) (1e6 * (tm - (int) tm));
+        tvp = &tv;
+      }
+      enter_blocking_section();
+      if (select(FD_SETSIZE, &read, &write, &except, tvp) == -1) {
+        err = WSAGetLastError();
+        DEBUG_PRINT("Error %ld occurred", err);
+      }
+      leave_blocking_section();
+      if (err) {
+        DEBUG_PRINT("Error %ld occurred", err);
+        win32_maperr(err);
+        uerror("select", Nothing);
+      }
+      read_list = fdset_to_fdlist(readfds, &read);
+      write_list = fdset_to_fdlist(writefds, &write);
+      except_list = fdset_to_fdlist(exceptfds, &except);
+    } else {
+      nEventsCount   = 0;
+      nEventsMax     = 0;
+      lpEventsDone   = NULL;
+      lpSelectData   = NULL;
+      iterSelectData = NULL;
+      iterResult     = NULL;
+      hasStaticData  = 0;
+      waitRet        = 0;
+      readfds_len    = caml_list_length(readfds);
+      writefds_len   = caml_list_length(writefds);
+      exceptfds_len  = caml_list_length(exceptfds);
+      hdsMax         = MAX(readfds_len, MAX(writefds_len, exceptfds_len));
       
-    DEBUG_PRINT("Waiting for every select worker to be done");
-    switch (WaitForMultipleObjects(nEventsCount, lpEventsDone, TRUE, INFINITE))
-    {
-      case WAIT_FAILED:
-        err = GetLastError();
-        break;
-
-      default:
-        DEBUG_PRINT("Every worker is done");
-        break;
-    }
-  }
-  /* Nothing to monitor but some time to wait. */
-  else if (!hasStaticData)
-  {
-    Sleep(milliseconds);
-  }
-  leave_blocking_section();
-
-  DEBUG_PRINT("Error status: %d (0 is ok)", err);
-  /* Build results */
-  if (err == 0)
-  {
-    DEBUG_PRINT("Building result");
-    read_list = Val_unit; 
-    write_list = Val_unit;
-    except_list = Val_unit;
-
-    iterSelectData = lpSelectData;
-    while (iterSelectData != NULL)
-    {
-      for (i = 0; i < iterSelectData->nResultsCount; i++)
-      {
-        iterResult = &(iterSelectData->aResults[i]);
-        l = alloc_small(2, 0);
-        Store_field(l, 0, find_handle(iterResult, readfds, writefds, exceptfds));
-        switch (iterResult->EMode)
+      hdsData = (HANDLE *)caml_stat_alloc(sizeof(HANDLE) * hdsMax);
+      
+      if (tm >= 0.0)
         {
-        case SELECT_MODE_READ:
-          Store_field(l, 1, read_list);
-          read_list = l;
-          break;
-        case SELECT_MODE_WRITE:
-          Store_field(l, 1, write_list);
-          write_list = l;
-          break;
-        case SELECT_MODE_EXCEPT:
-          Store_field(l, 1, except_list);
-          except_list = l;
-          break;
+          milliseconds = 1000 * tm;
+          DEBUG_PRINT("Will wait %d ms", milliseconds);
+        }
+      else
+        {
+          milliseconds = INFINITE;
+        }
+      
+      
+      /* Create list of select data, based on the different list of fd to watch */
+      DEBUG_PRINT("Dispatch read fd");
+      handle_set_init(&hds, hdsData, hdsMax);
+      i=0;
+      for (l = readfds; l != Val_int(0); l = Field(l, 1))
+        {
+          fd = Field(l, 0);
+          if (!handle_set_mem(&hds, Handle_val(fd)))
+            {
+              handle_set_add(&hds, Handle_val(fd));
+              lpSelectData = select_data_dispatch(lpSelectData, SELECT_MODE_READ, fd, i++);
+            }
+          else
+            {
+              DEBUG_PRINT("Discarding handle %x which is already monitor for read", Handle_val(fd));
+            }
+        }
+      handle_set_reset(&hds);
+      
+      DEBUG_PRINT("Dispatch write fd");
+      handle_set_init(&hds, hdsData, hdsMax);
+      i=0;
+      for (l = writefds; l != Val_int(0); l = Field(l, 1))
+        {
+          fd = Field(l, 0);
+          if (!handle_set_mem(&hds, Handle_val(fd)))
+            {
+              handle_set_add(&hds, Handle_val(fd));
+              lpSelectData = select_data_dispatch(lpSelectData, SELECT_MODE_WRITE, fd, i++);
+            }
+          else
+            {
+              DEBUG_PRINT("Discarding handle %x which is already monitor for write", Handle_val(fd));
+            }
+        }
+      handle_set_reset(&hds);
+      
+      DEBUG_PRINT("Dispatch exceptional fd");
+      handle_set_init(&hds, hdsData, hdsMax);
+      i=0;
+      for (l = exceptfds; l != Val_int(0); l = Field(l, 1))
+        {
+          fd = Field(l, 0);
+          if (!handle_set_mem(&hds, Handle_val(fd)))
+            {
+              handle_set_add(&hds, Handle_val(fd));
+              lpSelectData = select_data_dispatch(lpSelectData, SELECT_MODE_EXCEPT, fd, i++);
+            }
+          else
+            {
+              DEBUG_PRINT("Discarding handle %x which is already monitor for exceptional", Handle_val(fd));
+            }
+        }
+      handle_set_reset(&hds);
+      
+      /* Building the list of handle to wait for */
+      DEBUG_PRINT("Building events done array");
+      nEventsMax   = list_length((LPLIST)lpSelectData);
+      nEventsCount = 0;
+      lpEventsDone = (HANDLE *)caml_stat_alloc(sizeof(HANDLE) * nEventsMax);
+      
+      iterSelectData = lpSelectData;
+      while (iterSelectData != NULL)
+        {
+          /* Check if it is static data. If this is the case, launch everything
+           * but don't wait for events. It helps to test if there are events on
+           * any other fd (which are not static), knowing that there is at least
+           * one result (the static data).
+           */
+          if (iterSelectData->EType == SELECT_TYPE_STATIC)
+            {
+              hasStaticData = TRUE;
+            };
+          
+          /* Execute APC */
+          if (iterSelectData->funcWorker != NULL)
+            {
+              iterSelectData->lpWorker = 
+                worker_job_submit(
+                                  iterSelectData->funcWorker, 
+                                  (void *)iterSelectData);
+              DEBUG_PRINT("Job submitted to worker %x", iterSelectData->lpWorker); 
+              lpEventsDone[nEventsCount] = worker_job_event_done(iterSelectData->lpWorker);
+              nEventsCount++;
+            };
+          iterSelectData = LIST_NEXT(LPSELECTDATA, iterSelectData);
+        };
+      
+      DEBUG_PRINT("Need to watch %d workers", nEventsCount);
+      
+      /* Processing select itself */
+      enter_blocking_section();
+      /* There are worker started, waiting to be monitored */
+      if (nEventsCount > 0)
+        {
+          /* Waiting for event */
+          if (err == 0 && !hasStaticData)
+            {
+              DEBUG_PRINT("Waiting for one select worker to be done");
+              switch (WaitForMultipleObjects(nEventsCount, lpEventsDone, FALSE, milliseconds))
+                {
+                case WAIT_FAILED:
+                  err = GetLastError();
+                  break;
+                  
+                case WAIT_TIMEOUT:
+                  DEBUG_PRINT("Select timeout");
+                  break;
+                  
+                default:
+                  DEBUG_PRINT("One worker is done");
+                  break;
+                };
+            }
+          
+          /* Ordering stop to every worker */
+          DEBUG_PRINT("Sending stop signal to every select workers");
+          iterSelectData = lpSelectData;
+          while (iterSelectData != NULL)
+            {
+              if (iterSelectData->lpWorker != NULL)
+                {
+                  worker_job_stop(iterSelectData->lpWorker);
+                };
+              iterSelectData = LIST_NEXT(LPSELECTDATA, iterSelectData);
+            };
+          
+          DEBUG_PRINT("Waiting for every select worker to be done");
+          switch (WaitForMultipleObjects(nEventsCount, lpEventsDone, TRUE, INFINITE))
+            {
+            case WAIT_FAILED:
+              err = GetLastError();
+              break;
+              
+            default:
+              DEBUG_PRINT("Every worker is done");
+              break;
+            }
+        }
+      /* Nothing to monitor but some time to wait. */
+      else if (!hasStaticData)
+        {
+          Sleep(milliseconds);
+        }
+      leave_blocking_section();
+      
+      DEBUG_PRINT("Error status: %d (0 is ok)", err);
+      /* Build results */
+      if (err == 0)
+        {
+          DEBUG_PRINT("Building result");
+          read_list = Val_unit; 
+          write_list = Val_unit;
+          except_list = Val_unit;
+          
+          iterSelectData = lpSelectData;
+          while (iterSelectData != NULL)
+            {
+              for (i = 0; i < iterSelectData->nResultsCount; i++)
+                {
+                  iterResult = &(iterSelectData->aResults[i]);
+                  l = alloc_small(2, 0);
+                  Store_field(l, 0, find_handle(iterResult, readfds, writefds, exceptfds));
+                  switch (iterResult->EMode)
+                    {
+                    case SELECT_MODE_READ:
+                      Store_field(l, 1, read_list);
+                      read_list = l;
+                      break;
+                    case SELECT_MODE_WRITE:
+                      Store_field(l, 1, write_list);
+                      write_list = l;
+                      break;
+                    case SELECT_MODE_EXCEPT:
+                      Store_field(l, 1, except_list);
+                      except_list = l;
+                      break;
+                    }
+                }
+              /* We try to only process the first error, bypass other errors */
+              if (err == 0 && iterSelectData->EState == SELECT_STATE_ERROR)
+                {
+                  err = iterSelectData->nError;
+                }
+              iterSelectData = LIST_NEXT(LPSELECTDATA, iterSelectData);
+            }
+        }
+      
+      /* Free resources */
+      DEBUG_PRINT("Free selectdata resources");
+      iterSelectData = lpSelectData;
+      while (iterSelectData != NULL)
+        {
+          lpSelectData = iterSelectData;
+          iterSelectData = LIST_NEXT(LPSELECTDATA, iterSelectData);
+          select_data_free(lpSelectData);
+        }
+      lpSelectData = NULL;
+      
+      /* Free allocated events/handle set array */
+      DEBUG_PRINT("Free local allocated resources");
+      caml_stat_free(lpEventsDone);
+      caml_stat_free(hdsData);
+      
+      DEBUG_PRINT("Raise error if required");
+      if (err != 0)
+        {
+          win32_maperr(err);
+          uerror("select", Nothing);
         }
-      }
-      /* We try to only process the first error, bypass other errors */
-      if (err == 0 && iterSelectData->EState == SELECT_STATE_ERROR)
-      {
-        err = iterSelectData->nError;
-      }
-      iterSelectData = LIST_NEXT(LPSELECTDATA, iterSelectData);
     }
   }
 
-  /* Free resources */
-  DEBUG_PRINT("Free selectdata resources");
-  iterSelectData = lpSelectData;
-  while (iterSelectData != NULL)
-  {
-    lpSelectData = iterSelectData;
-    iterSelectData = LIST_NEXT(LPSELECTDATA, iterSelectData);
-    select_data_free(lpSelectData);
-  }
-  lpSelectData = NULL;
-  
-  /* Free allocated events/handle set array */
-  DEBUG_PRINT("Free local allocated resources");
-  caml_stat_free(lpEventsDone);
-  caml_stat_free(hdsData);
-
-  DEBUG_PRINT("Raise error if required");
-  if (err != 0)
-  {
-    win32_maperr(err);
-    uerror("select", Nothing);
-  }
-
   DEBUG_PRINT("Build final result");
   res = alloc_small(3, 0);
   Store_field(res, 0, read_list);
diff --git a/otherlibs/win32unix/socket.c b/otherlibs/win32unix/socket.c
index abdab25f3a..37ad175d26 100644
--- a/otherlibs/win32unix/socket.c
+++ b/otherlibs/win32unix/socket.c
@@ -28,25 +28,9 @@ CAMLprim value unix_socket(domain, type, proto)
      value domain, type, proto;
 {
   SOCKET s;
-  int oldvalue, oldvaluelen, newvalue, retcode;
-
-  oldvaluelen = sizeof(oldvalue);
-  retcode = getsockopt(INVALID_SOCKET, SOL_SOCKET, SO_OPENTYPE,
-                       (char *) &oldvalue, &oldvaluelen);
-  if (retcode == 0) {
-    /* Set sockets to synchronous mode */
-    newvalue = SO_SYNCHRONOUS_NONALERT;
-    setsockopt(INVALID_SOCKET, SOL_SOCKET, SO_OPENTYPE,
-               (char *) &newvalue, sizeof(newvalue));
-  }
   s = socket(socket_domain_table[Int_val(domain)],
                    socket_type_table[Int_val(type)],
                    Int_val(proto));
-  if (retcode == 0) {
-    /* Restore initial mode */
-    setsockopt(INVALID_SOCKET, SOL_SOCKET, SO_OPENTYPE,
-               (char *) &oldvalue, oldvaluelen);
-  }
   if (s == INVALID_SOCKET) {
     win32_maperr(WSAGetLastError());
     uerror("socket", Nothing);
diff --git a/otherlibs/win32unix/times.c b/otherlibs/win32unix/times.c
new file mode 100644
index 0000000000..725895ec15
--- /dev/null
+++ b/otherlibs/win32unix/times.c
@@ -0,0 +1,35 @@
+#include <windows.h>

+#include <mlvalues.h>

+#include "unixsupport.h"

+

+

+double to_sec(FILETIME ft) {

+  ULARGE_INTEGER tmp;

+

+  tmp.u.LowPart = ft.dwLowDateTime;

+  tmp.u.HighPart = ft.dwHighDateTime;

+

+  /* convert to seconds:

+     GetProcessTimes returns number of 100-nanosecond intervals */

+  return tmp.QuadPart / 1e7;

+}

+

+

+value unix_times(value unit) {

+

+  value res;

+  FILETIME creation, exit, stime, utime;

+

+  if (!(GetProcessTimes(GetCurrentProcess(), &creation, &exit, &stime, &utime))) {

+    win32_maperr(GetLastError());

+    uerror("times", Nothing);

+  }

+

+  res = alloc_small(4 * Double_wosize, Double_array_tag);

+  Store_double_field(res, 0, to_sec(utime));

+  Store_double_field(res, 1, to_sec(stime));

+  Store_double_field(res, 2, 0);

+  Store_double_field(res, 3, 0);

+  return res;

+

+}

diff --git a/otherlibs/win32unix/unix.ml b/otherlibs/win32unix/unix.ml
index 56d33bde88..19c278240f 100644
--- a/otherlibs/win32unix/unix.ml
+++ b/otherlibs/win32unix/unix.ml
@@ -408,9 +408,7 @@ external localtime : float -> tm = "unix_localtime"
 external mktime : tm -> float * tm = "unix_mktime"
 let alarm n = invalid_arg "Unix.alarm not implemented"
 external sleep : int -> unit = "unix_sleep"
-let times () =
-  { tms_utime = Sys.time(); tms_stime = 0.0;
-    tms_cutime = 0.0; tms_cstime = 0.0 }
+external times: unit -> process_times = "unix_times"
 external utimes : string -> float -> float -> unit = "unix_utimes"
 
 type interval_timer =
diff --git a/otherlibs/win32unix/windbug.h b/otherlibs/win32unix/windbug.h
index 3e23413619..efaeffc011 100644
--- a/otherlibs/win32unix/windbug.h
+++ b/otherlibs/win32unix/windbug.h
@@ -18,13 +18,15 @@
 #include <stdio.h>
 #include <windows.h>
 
+/* According to MSDN, MSVC supports the gcc ## operator (to deal with empty argument lists)
+ */
 #define DEBUG_PRINT(fmt, ...) \
   do \
   { \
     if (debug_test()) \
     { \
-      fprintf(stderr, "DBUG (pid:%d, tid: %d): ", GetCurrentProcessId(), GetCurrentThreadId()); \
-      fprintf(stderr, fmt, __VA_ARGS__); \
+      fprintf(stderr, "DBUG (pid:%ld, tid: %ld): ", GetCurrentProcessId(), GetCurrentThreadId()); \
+      fprintf(stderr, fmt, ##__VA_ARGS__); \
       fprintf(stderr, "\n"); \
       fflush(stderr); \
     }; \
diff --git a/parsing/parser.mly b/parsing/parser.mly
index 43a485151f..885a581d45 100644
--- a/parsing/parser.mly
+++ b/parsing/parser.mly
@@ -982,9 +982,6 @@ expr:
       { mkexp(Pexp_apply($1, List.rev $2)) }
   | LET rec_flag let_bindings IN seq_expr
       { mkexp(Pexp_let($2, List.rev $3, $5)) }
-  | LET DOT simple_expr let_binding IN seq_expr
-      { let (pat, expr) = $4 in
-        mkexp(Pexp_apply($3, ["", expr;  "", ghexp(Pexp_function("", None, [pat, $6]))])) }
   | LET MODULE UIDENT module_binding IN seq_expr
       { mkexp(Pexp_letmodule($3, $4, $6)) }
   | LET OPEN mod_longident IN seq_expr
diff --git a/parsing/parsetree.mli b/parsing/parsetree.mli
index e67e3ebfee..663ae7c55b 100644
--- a/parsing/parsetree.mli
+++ b/parsing/parsetree.mli
@@ -195,7 +195,6 @@ and class_field =
   | Pcf_meth of
       (string * private_flag * override_flag * expression * Location.t)
   | Pcf_cstr of (core_type * core_type * Location.t)
-  | Pcf_let of rec_flag * (pattern * expression) list * Location.t
   | Pcf_init of expression
 
 and class_declaration = class_expr class_infos
diff --git a/parsing/printast.ml b/parsing/printast.ml
index 7aafabb39e..d5b9933113 100644
--- a/parsing/printast.ml
+++ b/parsing/printast.ml
@@ -489,9 +489,6 @@ and class_field i ppf x =
       line i ppf "Pcf_cstr %a\n" fmt_location loc;
       core_type (i+1) ppf ct1;
       core_type (i+1) ppf ct2;
-  | Pcf_let (rf, l, loc) ->
-      line i ppf "Pcf_let %a %a\n" fmt_rec_flag rf fmt_location loc;
-      list (i+1) pattern_x_expression_def ppf l;
   | Pcf_init (e) ->
       line i ppf "Pcf_init\n";
       expression (i+1) ppf e;
diff --git a/stdlib/arg.ml b/stdlib/arg.ml
index d5d1bdf74d..8453058e4e 100644
--- a/stdlib/arg.ml
+++ b/stdlib/arg.ml
@@ -64,10 +64,11 @@ let make_symlist prefix sep suffix l =
 ;;
 
 let print_spec buf (key, spec, doc) =
-  match spec with
-  | Symbol (l, _) -> bprintf buf "  %s %s%s\n" key (make_symlist "{" "|" "}" l)
-                             doc
-  | _ -> bprintf buf "  %s %s\n" key doc
+  if String.length doc > 0 then
+    match spec with
+    | Symbol (l, _) -> 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"));;
@@ -237,6 +238,10 @@ let max_arg_len cur (kwd, spec, doc) =
 
 let add_padding len ksd =
   match ksd with
+  | (_, _, "") ->
+      (* Do not pad undocumented options, so that they still don't show up when
+       * run through [usage] or [parse]. *)
+      ksd
   | (kwd, (Symbol (l, _) as spec), msg) ->
       let cutcol = second_word msg in
       let spaces = String.make (len - cutcol + 3) ' ' in
diff --git a/stdlib/arg.mli b/stdlib/arg.mli
index 1fff78f190..d6e0210aa1 100644
--- a/stdlib/arg.mli
+++ b/stdlib/arg.mli
@@ -83,6 +83,8 @@ val parse :
 -   The reason for the error: unknown option, invalid or missing argument, etc.
 -   [usage_msg]
 -   The list of options, each followed by the corresponding [doc] string.
+    Beware: options that have an empty [doc] string will not be included in the
+    list.
 
     For the user to be able to specify anonymous arguments starting with a
     [-], include for example [("-", String anon_fun, doc)] in [speclist].
diff --git a/stdlib/array.ml b/stdlib/array.ml
index e29b2fe831..076a3af031 100644
--- a/stdlib/array.ml
+++ b/stdlib/array.ml
@@ -1,6 +1,6 @@
 (***********************************************************************)
 (*                                                                     *)
-(*                                OCaml                                *)
+(*                           OCaml                                     *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
@@ -22,6 +22,10 @@ external unsafe_get: 'a array -> int -> 'a = "%array_unsafe_get"
 external unsafe_set: 'a array -> int -> 'a -> unit = "%array_unsafe_set"
 external make: int -> 'a -> 'a array = "caml_make_vect"
 external create: int -> 'a -> 'a array = "caml_make_vect"
+external sub : 'a array -> int -> int -> 'a array = "caml_array_sub"
+external append_prim : 'a array -> 'a array -> 'a array = "caml_array_append"
+external concat : 'a array list -> 'a array = "caml_array_concat"
+external unsafe_blit : 'a array -> int -> 'a array -> int -> int -> unit = "caml_array_blit"
 
 let init l f =
   if l = 0 then [||] else
@@ -41,58 +45,13 @@ let make_matrix sx sy init =
 let create_matrix = make_matrix
 
 let copy a =
-  let l = length a in
-  if l = 0 then [||] else begin
-    let res = create l (unsafe_get a 0) in
-    for i = 1 to pred l do
-      unsafe_set res i (unsafe_get a i)
-    done;
-    res
-  end
+  let l = length a in if l = 0 then [||] else sub a 0 l
 
 let append a1 a2 =
-  let l1 = length a1 and l2 = length a2 in
-  if l1 = 0 && l2 = 0 then [||] else begin
-    let r = create (l1 + l2) (unsafe_get (if l1 > 0 then a1 else a2) 0) in
-    for i = 0 to l1 - 1 do unsafe_set r i (unsafe_get a1 i) done;
-    for i = 0 to l2 - 1 do unsafe_set r (i + l1) (unsafe_get a2 i) done;
-    r
-  end
-
-let concat_aux init al =
-  let rec size accu = function
-    | [] -> accu
-    | h::t -> size (accu + length h) t
-  in
-  let res = create (size 0 al) init in
-  let rec fill pos = function
-    | [] -> ()
-    | h::t ->
-        for i = 0 to length h - 1 do
-          unsafe_set res (pos + i) (unsafe_get h i);
-        done;
-        fill (pos + length h) t;
-  in
-  fill 0 al;
-  res
-;;
-
-let concat al =
-  let rec find_init aa =
-    match aa with
-    | [] -> [||]
-    | a :: rem ->
-        if length a > 0 then concat_aux (unsafe_get a 0) aa else find_init rem
-  in find_init al
-
-let sub a ofs len =
-  if ofs < 0 || len < 0 || ofs > length a - len then invalid_arg "Array.sub"
-  else if len = 0 then [||]
-  else begin
-    let r = create len (unsafe_get a ofs) in
-    for i = 1 to len - 1 do unsafe_set r i (unsafe_get a (ofs + i)) done;
-    r
-  end
+  let l1 = length a1 in
+  if l1 = 0 then copy a2
+  else if length a2 = 0 then sub a1 0 l1
+  else append_prim a1 a2
 
 let fill a ofs len v =
   if ofs < 0 || len < 0 || ofs > length a - len
@@ -103,16 +62,7 @@ let blit a1 ofs1 a2 ofs2 len =
   if len < 0 || ofs1 < 0 || ofs1 > length a1 - len
              || ofs2 < 0 || ofs2 > length a2 - len
   then invalid_arg "Array.blit"
-  else if ofs1 < ofs2 then
-    (* Top-down copy *)
-    for i = len - 1 downto 0 do
-      unsafe_set a2 (ofs2 + i) (unsafe_get a1 (ofs1 + i))
-    done
-  else
-    (* Bottom-up copy *)
-    for i = 0 to len - 1 do
-      unsafe_set a2 (ofs2 + i) (unsafe_get a1 (ofs1 + i))
-    done
+  else unsafe_blit a1 ofs1 a2 ofs2 len
 
 let iter f a =
   for i = 0 to length a - 1 do f(unsafe_get a i) done
diff --git a/stdlib/callback.ml b/stdlib/callback.ml
index a8a490c46b..5dd7894846 100644
--- a/stdlib/callback.ml
+++ b/stdlib/callback.ml
@@ -13,7 +13,7 @@
 
 (* $Id$ *)
 
-(* Registering Caml values with the C runtime for later callbacks *)
+(* Registering OCaml values with the C runtime for later callbacks *)
 
 external register_named_value : string -> Obj.t -> unit
                               = "caml_register_named_value"
diff --git a/stdlib/callback.mli b/stdlib/callback.mli
index dfb31617a2..ca5f1f073d 100644
--- a/stdlib/callback.mli
+++ b/stdlib/callback.mli
@@ -13,11 +13,11 @@
 
 (* $Id$ *)
 
-(** Registering Caml values with the C runtime.
+(** Registering OCaml values with the C runtime.
 
-   This module allows Caml values to be registered with the C runtime
+   This module allows OCaml values to be registered with the C runtime
    under a symbolic name, so that C code can later call back registered
-   Caml functions, or raise registered Caml exceptions.
+   OCaml functions, or raise registered OCaml exceptions.
 *)
 
 val register : string -> 'a -> unit
diff --git a/stdlib/camlinternalOO.ml b/stdlib/camlinternalOO.ml
index db3aef73df..6d78714655 100644
--- a/stdlib/camlinternalOO.ml
+++ b/stdlib/camlinternalOO.ml
@@ -18,8 +18,7 @@ open Obj
 (**** Object representation ****)
 
 let last_id = ref 0
-let new_id () =
-  let id = !last_id in incr last_id; id
+let () = Callback.register "CamlinternalOO.last_id" last_id
 
 let set_id o id =
   let id0 = !id in
diff --git a/stdlib/digest.ml b/stdlib/digest.ml
index 7d69141561..47c7e65a7a 100644
--- a/stdlib/digest.ml
+++ b/stdlib/digest.ml
@@ -17,6 +17,8 @@
 
 type t = string
 
+let compare = String.compare
+
 external unsafe_string: string -> int -> int -> t = "caml_md5_string"
 external channel: in_channel -> int -> t = "caml_md5_chan"
 
@@ -48,4 +50,3 @@ let to_hex d =
     String.blit (Printf.sprintf "%02x" (int_of_char d.[i])) 0 result (2*i) 2;
   done;
   result
-;;
diff --git a/stdlib/digest.mli b/stdlib/digest.mli
index 14f27e2630..01a5f8ba8a 100644
--- a/stdlib/digest.mli
+++ b/stdlib/digest.mli
@@ -18,12 +18,22 @@
    This module provides functions to compute 128-bit ``digests'' of
    arbitrary-length strings or files. The digests are of cryptographic
    quality: it is very hard, given a digest, to forge a string having
-   that digest. The algorithm used is MD5.
+   that digest. The algorithm used is MD5. This module should not be
+   used for secure and sensitive cryptographic applications. For these
+   kind of applications more recent and stronger cryptographic
+   primitives should be used instead.
 *)
 
 type t = string
 (** The type of digests: 16-character strings. *)
 
+val compare : t -> t -> int
+(** The comparison function for 16-character digest, with the same
+    specification as {!Pervasives.compare} and the implementation
+    shared with {!String.compare}. Along with the type [t], this
+    function [compare] allows the module [Digest] to be passed as
+    argument to the functors {!Set.Make} and {!Map.Make}. *)
+
 val string : string -> t
 (** Return the digest of the given string. *)
 
diff --git a/stdlib/filename.ml b/stdlib/filename.ml
index 92bd217188..8c3ad53155 100644
--- a/stdlib/filename.ml
+++ b/stdlib/filename.ml
@@ -25,30 +25,55 @@ let generic_quote quotequote s =
   Buffer.add_char b '\'';
   Buffer.contents b
 
-let generic_basename rindex_dir_sep current_dir_name name =
-  let raw_name =
-    try
-      let p = rindex_dir_sep name + 1 in
-      String.sub name p (String.length name - p)
-    with Not_found ->
-      name
+(* This function implements the Open Group specification found here:
+  [[1]] http://pubs.opengroup.org/onlinepubs/9699919799/utilities/basename.html
+  In step 1 of [[1]], we choose to return "." for empty input.
+    (for compatibility with previous versions of OCaml)
+  In step 2, we choose to process "//" normally.
+  Step 6 is not implemented: we consider that the [suffix] operand is
+    always absent.  Suffixes are handled by [chop_suffix] and [chop_extension].
+*)
+let generic_basename is_dir_sep current_dir_name name =
+  let rec find_end n =
+    if n < 0 then String.sub name 0 1
+    else if is_dir_sep name n then find_end (n - 1)
+    else find_beg n (n + 1)
+  and find_beg n p =
+    if n < 0 then String.sub name 0 p
+    else if is_dir_sep name n then String.sub name (n + 1) (p - n - 1)
+    else find_beg (n - 1) p
   in
-  if raw_name = "" then current_dir_name else raw_name
-
-let generic_dirname rindex_dir_sep current_dir_name dir_sep name =
-  try
-    match rindex_dir_sep name with
-      0 -> dir_sep
-    | n -> String.sub name 0 n
-  with Not_found ->
-    current_dir_name
+  if name = ""
+  then current_dir_name
+  else find_end (String.length name - 1)
+
+(* This function implements the Open Group specification found here:
+  [[2]] http://pubs.opengroup.org/onlinepubs/9699919799/utilities/dirname.html
+  In step 6 of [[2]], we choose to process "//" normally.
+*)
+let generic_dirname is_dir_sep current_dir_name name =
+  let rec trailing_sep n =
+    if n < 0 then String.sub name 0 1
+    else if is_dir_sep name n then trailing_sep (n - 1)
+    else base n
+  and base n =
+    if n < 0 then current_dir_name
+    else if is_dir_sep name n then intermediate_sep n
+    else base (n - 1)
+  and intermediate_sep n =
+    if n < 0 then String.sub name 0 1
+    else if is_dir_sep name n then intermediate_sep (n - 1)
+    else String.sub name 0 (n + 1)
+  in
+  if name = ""
+  then current_dir_name
+  else trailing_sep (String.length name - 1)
 
 module Unix = struct
   let current_dir_name = "."
   let parent_dir_name = ".."
   let dir_sep = "/"
   let is_dir_sep s i = s.[i] = '/'
-  let rindex_dir_sep s = String.rindex s '/'
   let is_relative n = String.length n < 1 || n.[0] <> '/';;
   let is_implicit n =
     is_relative n
@@ -61,8 +86,8 @@ module Unix = struct
   let temp_dir_name =
     try Sys.getenv "TMPDIR" with Not_found -> "/tmp"
   let quote = generic_quote "'\\''"
-  let basename = generic_basename rindex_dir_sep current_dir_name
-  let dirname = generic_dirname rindex_dir_sep current_dir_name dir_sep
+  let basename = generic_basename is_dir_sep current_dir_name
+  let dirname = generic_dirname is_dir_sep current_dir_name
 end
 
 module Win32 = struct
@@ -70,12 +95,6 @@ module Win32 = struct
   let parent_dir_name = ".."
   let dir_sep = "\\"
   let is_dir_sep s i = let c = s.[i] in c = '/' || c = '\\' || c = ':'
-  let rindex_dir_sep s =
-    let rec pos i =
-      if i < 0 then raise Not_found
-      else if is_dir_sep s i then i
-      else pos (i - 1)
-    in pos (String.length s - 1)
   let is_relative n =
     (String.length n < 1 || n.[0] <> '/')
     && (String.length n < 1 || n.[0] <> '\\')
@@ -129,11 +148,11 @@ module Win32 = struct
     else ("", s)
   let dirname s =
     let (drive, path) = drive_and_path s in
-    let dir = generic_dirname rindex_dir_sep current_dir_name dir_sep path in
+    let dir = generic_dirname is_dir_sep current_dir_name path in
     drive ^ dir
   let basename s =
     let (drive, path) = drive_and_path s in
-    generic_basename rindex_dir_sep current_dir_name path
+    generic_basename is_dir_sep current_dir_name path
 end
 
 module Cygwin = struct
@@ -141,33 +160,32 @@ module Cygwin = struct
   let parent_dir_name = ".."
   let dir_sep = "/"
   let is_dir_sep = Win32.is_dir_sep
-  let rindex_dir_sep = Win32.rindex_dir_sep
   let is_relative = Win32.is_relative
   let is_implicit = Win32.is_implicit
   let check_suffix = Win32.check_suffix
   let temp_dir_name = Unix.temp_dir_name
   let quote = Unix.quote
-  let basename = generic_basename rindex_dir_sep current_dir_name
-  let dirname = generic_dirname rindex_dir_sep current_dir_name dir_sep
+  let basename = generic_basename is_dir_sep current_dir_name
+  let dirname = generic_dirname is_dir_sep current_dir_name
 end
 
-let (current_dir_name, parent_dir_name, dir_sep, is_dir_sep, rindex_dir_sep,
+let (current_dir_name, parent_dir_name, dir_sep, is_dir_sep,
      is_relative, is_implicit, check_suffix, temp_dir_name, quote, basename,
      dirname) =
   match Sys.os_type with
     "Unix" ->
       (Unix.current_dir_name, Unix.parent_dir_name, Unix.dir_sep,
-       Unix.is_dir_sep, Unix.rindex_dir_sep,
+       Unix.is_dir_sep,
        Unix.is_relative, Unix.is_implicit, Unix.check_suffix,
        Unix.temp_dir_name, Unix.quote, Unix.basename, Unix.dirname)
   | "Win32" ->
       (Win32.current_dir_name, Win32.parent_dir_name, Win32.dir_sep,
-       Win32.is_dir_sep, Win32.rindex_dir_sep,
+       Win32.is_dir_sep,
        Win32.is_relative, Win32.is_implicit, Win32.check_suffix,
        Win32.temp_dir_name, Win32.quote, Win32.basename, Win32.dirname)
   | "Cygwin" ->
       (Cygwin.current_dir_name, Cygwin.parent_dir_name, Cygwin.dir_sep,
-       Cygwin.is_dir_sep, Cygwin.rindex_dir_sep,
+       Cygwin.is_dir_sep,
        Cygwin.is_relative, Cygwin.is_implicit, Cygwin.check_suffix,
        Cygwin.temp_dir_name, Cygwin.quote, Cygwin.basename, Cygwin.dirname)
   | _ -> assert false
diff --git a/stdlib/filename.mli b/stdlib/filename.mli
index 7e447585ca..b4644ad67d 100644
--- a/stdlib/filename.mli
+++ b/stdlib/filename.mli
@@ -59,17 +59,19 @@ val chop_extension : string -> string
 
 val basename : string -> string
 (** Split a file name into directory name / base file name.
-   [concat (dirname name) (basename name)] returns a file name
-   which is equivalent to [name]. Moreover, after setting the
-   current directory to [dirname name] (with {!Sys.chdir}),
+   If [name] is a valid file name, then [concat (dirname name) (basename name)]
+   returns a file name which is equivalent to [name]. Moreover,
+   after setting the current directory to [dirname name] (with {!Sys.chdir}),
    references to [basename name] (which is a relative file name)
    designate the same file as [name] before the call to {!Sys.chdir}.
 
-   The result is not specified if the argument is not a valid file name
-   (for example, under Unix if there is a NUL character in the string). *)
+   This function conforms to the specification of POSIX.1-2008 for the
+   [basename] utility. *)
 
 val dirname : string -> string
-(** See {!Filename.basename}. *)
+(** See {!Filename.basename}.
+   This function conforms to the specification of POSIX.1-2008 for the
+   [dirname] utility. *)
 
 val temp_file : ?temp_dir: string -> string -> string -> string
 (** [temp_file prefix suffix] returns the name of a
diff --git a/stdlib/gc.mli b/stdlib/gc.mli
index ec6cc17c30..71b8ffa783 100644
--- a/stdlib/gc.mli
+++ b/stdlib/gc.mli
@@ -123,6 +123,8 @@ type control =
        compaction is triggered at the end of each major GC cycle
        (this setting is intended for testing purposes only).
        If [max_overhead >= 1000000], compaction is never triggered.
+       If compaction is permanently disabled, it is strongly suggested
+       to set [allocation_policy] to 1.
        Default: 500. *)
 
     mutable stack_limit : int;
@@ -221,7 +223,7 @@ val finalise : ('a -> unit) -> 'a -> unit
    - [ let f = fun x -> ... ;; let v = ... in Gc.finalise f v ]
 
 
-   The [f] function can use all features of O'Caml, including
+   The [f] function can use all features of OCaml, including
    assignments that make the value reachable again.  It can also
    loop forever (in this case, the other
    finalisation functions will not be called during the execution of f,
diff --git a/stdlib/genlex.mli b/stdlib/genlex.mli
index d7cecc781e..41ce68d0fd 100644
--- a/stdlib/genlex.mli
+++ b/stdlib/genlex.mli
@@ -18,7 +18,7 @@
 
    This module implements a simple ``standard'' lexical analyzer, presented
    as a function from character streams to token streams. It implements
-   roughly the lexical conventions of Caml, but is parameterized by the
+   roughly the lexical conventions of OCaml, but is parameterized by the
    set of keywords of your language.
 
 
diff --git a/stdlib/hashtbl.mli b/stdlib/hashtbl.mli
index 6dcfdafcfa..3f1a77d54d 100644
--- a/stdlib/hashtbl.mli
+++ b/stdlib/hashtbl.mli
@@ -35,7 +35,7 @@ val create : ?seed:int -> int -> ('a, 'b) t
    The optional [seed] parameter (an integer) can be given to
    diversify the hash function used to access the returned table.
    With high probability, hash tables created with different seeds
-   have different collision patterns.  In Web-facing applications 
+   have different collision patterns.  In Web-facing applications
    for instance, it is recommended to create hash tables with a
    randomly-chosen seed.  This prevents a denial-of-service attack
    whereas a malicious user sends input crafted to create many
@@ -124,7 +124,8 @@ type statistics = {
 val stats : ('a, 'b) t -> statistics
 (** [Hashtbl.stats tbl] returns statistics about the table [tbl]:
    number of buckets, size of the biggest bucket, distribution of
-   buckets by size. *)
+   buckets by size.
+   @since 3.13.0 *)
 
 (** {6 Functorial interface} *)
 
@@ -226,7 +227,7 @@ module MakeSeeded (H : SeededHashedType) : SeededS with type key = H.t
     The operations perform similarly to those of the generic
     interface, but use the seeded hashing and equality functions
     specified in the functor argument [H] instead of generic
-    equality and hashing. 
+    equality and hashing.
     @since 3.13.0 *)
 
 
@@ -263,10 +264,6 @@ val hash_param : int -> int -> 'a -> int
 
 val seeded_hash_param : int -> int -> int -> 'a -> int
 (** A variant of {!Hashtbl.hash_param} that is further parameterized by
-   an integer seed.  Usage: 
+   an integer seed.  Usage:
    [Hashtbl.seeded_hash_param meaningful total seed x].
    @since 3.13.0 *)
-
-
-
-
diff --git a/stdlib/list.mli b/stdlib/list.mli
index 996436ef50..96166e25d9 100644
--- a/stdlib/list.mli
+++ b/stdlib/list.mli
@@ -76,9 +76,9 @@ val iter : ('a -> unit) -> 'a list -> unit
    [begin f a1; f a2; ...; f an; () end]. *)
 
 val iteri : (int -> 'a -> unit) -> 'a list -> unit
-(** Same as {!List.iter}, but the
-   function is applied to the index of the element as first argument (counting from 0),
-   and the element itself as second argument.
+(** Same as {!List.iter}, but the function is applied to the index of
+   the element as first argument (counting from 0), and the element
+   itself as second argument.
    @since 3.13.0
 *)
 
@@ -88,9 +88,9 @@ val map : ('a -> 'b) -> 'a list -> 'b list
    with the results returned by [f].  Not tail-recursive. *)
 
 val mapi : (int -> 'a -> 'b) -> 'a list -> 'b list
-(** Same as {!List.map}, but the
-   function is applied to the index of the element as first argument (counting from 0),
-   and the element itself as second argument.
+(** Same as {!List.map}, but the function is applied to the index of
+   the element as first argument (counting from 0), and the element
+   itself as second argument.  Not tail-recursive.
    @since 3.13.0
 *)
 
diff --git a/stdlib/map.ml b/stdlib/map.ml
index 8f658b2126..519ef824e7 100644
--- a/stdlib/map.ml
+++ b/stdlib/map.ml
@@ -200,27 +200,31 @@ module Make(Ord: OrderedType) = struct
         Empty -> false
       | Node(l, v, d, r, _) -> p v d || exists p l || exists p r
 
-    let filter p s =
-      let rec filt accu = function
-        | Empty -> accu
-        | Node(l, v, d, r, _) ->
-            filt (filt (if p v d then add v d accu else accu) l) r in
-      filt Empty s
-
-    let partition p s =
-      let rec part (t, f as accu) = function
-        | Empty -> accu
-        | Node(l, v, d, r, _) ->
-            part (part (if p v d then (add v d t, f) else (t, add v d f)) l) r in
-      part (Empty, Empty) s
+    (* Beware: those two functions assume that the added k is *strictly*
+       smaller (or bigger) than all the present keys in the tree; it
+       does not test for equality with the current min (or max) key.
+
+       Indeed, they are only used during the "join" operation which
+       respects this precondition.
+    *)
+
+    let rec add_min_binding k v = function
+      | Empty -> singleton k v
+      | Node (l, x, d, r, h) ->
+        bal (add_min_binding k v l) x d r
+
+    let rec add_max_binding k v = function
+      | Empty -> singleton k v
+      | Node (l, x, d, r, h) ->
+        bal l x d (add_max_binding k v r)
 
     (* Same as create and bal, but no assumptions are made on the
        relative heights of l and r. *)
 
     let rec join l v d r =
       match (l, r) with
-        (Empty, _) -> add v d r
-      | (_, Empty) -> add v d l
+        (Empty, _) -> add_min_binding v d r
+      | (_, Empty) -> add_max_binding v d l
       | (Node(ll, lv, ld, lr, lh), Node(rl, rv, rd, rr, rh)) ->
           if lh > rh + 2 then bal ll lv ld (join lr v d r) else
           if rh > lh + 2 then bal (join l v d rl) rv rd rr else
@@ -266,6 +270,20 @@ module Make(Ord: OrderedType) = struct
       | _ ->
           assert false
 
+    let rec filter p = function
+        Empty -> Empty
+      | Node(l, v, d, r, _) ->
+          let l' = filter p l and r' = filter p r in
+          if p v d then join l' v d r' else concat l' r'
+
+    let rec partition p = function
+        Empty -> (Empty, Empty)
+      | Node(l, v, d, r, _) ->
+          let (lt, lf) = partition p l and (rt, rf) = partition p r in
+          if p v d
+          then (join lt v d rt, concat lf rf)
+          else (concat lt rt, join lf v d rf)
+
     type 'a enumeration = End | More of key * 'a * 'a t * 'a enumeration
 
     let rec cons_enum m e =
diff --git a/stdlib/marshal.mli b/stdlib/marshal.mli
index 90e6dbffe1..86e1ebd199 100644
--- a/stdlib/marshal.mli
+++ b/stdlib/marshal.mli
@@ -27,7 +27,7 @@
    making it impossible to check that the data read back possesses the
    type expected by the context. In particular, the result type of
    the [Marshal.from_*] functions is given as ['a], but this is
-   misleading: the returned Caml value does not possess type ['a]
+   misleading: the returned OCaml value does not possess type ['a]
    for all ['a]; it has one, unique type which cannot be determined
    at compile-type.  The programmer should explicitly give the expected
    type of the returned value, using the following syntax:
diff --git a/stdlib/oo.mli b/stdlib/oo.mli
index cd83151bb8..508217228b 100644
--- a/stdlib/oo.mli
+++ b/stdlib/oo.mli
@@ -17,11 +17,17 @@
 
 val copy : (< .. > as 'a) -> 'a
 (** [Oo.copy o] returns a copy of object [o], that is a fresh
-   object with the same methods and instance variables as [o]  *)
+   object with the same methods and instance variables as [o]. *)
 
 external id : < .. > -> int = "%field1"
 (** Return an integer identifying this object, unique for
-    the current execution of the program. *)
+    the current execution of the program. The generic comparison
+    and hashing functions are based on this integer. When an object
+    is obtained by unmarshaling, the id is refreshed, and thus
+    different from the original object. As a consequence, the internal
+    invariants of data structures such as hash table or sets containing
+    objects are broken after unmarshaling the data structures.
+  *)
 
 (**/**)
 (** For internal use (CamlIDL) *)
diff --git a/stdlib/pervasives.ml b/stdlib/pervasives.ml
index 5148f228fa..17a1a9c1a8 100644
--- a/stdlib/pervasives.ml
+++ b/stdlib/pervasives.ml
@@ -52,7 +52,6 @@ external ( || ) : bool -> bool -> bool = "%sequor"
 
 external ( ~- ) : int -> int = "%negint"
 external ( ~+ ) : int -> int = "%identity"
-external (~+) : int -> int = "%identity"
 external succ : int -> int = "%succint"
 external pred : int -> int = "%predint"
 external ( + ) : int -> int -> int = "%addint"
@@ -91,7 +90,8 @@ external acos : float -> float = "caml_acos_float" "acos" "float"
 external asin : float -> float = "caml_asin_float" "asin" "float"
 external atan : float -> float = "caml_atan_float" "atan" "float"
 external atan2 : float -> float -> float = "caml_atan2_float" "atan2" "float"
-external hypot : float -> float -> float = "caml_hypot_float" "caml_hypot" "float"
+external hypot : float -> float -> float
+               = "caml_hypot_float" "caml_hypot" "float"
 external cos : float -> float = "caml_cos_float" "cos" "float"
 external cosh : float -> float = "caml_cosh_float" "cosh" "float"
 external log : float -> float = "caml_log_float" "log" "float"
@@ -105,7 +105,8 @@ external tanh : float -> float = "caml_tanh_float" "tanh" "float"
 external ceil : float -> float = "caml_ceil_float" "ceil" "float"
 external floor : float -> float = "caml_floor_float" "floor" "float"
 external abs_float : float -> float = "%absfloat"
-external copysign : float -> float -> float = "caml_copysign_float" "caml_copysign" "float"
+external copysign : float -> float -> float
+                  = "caml_copysign_float" "caml_copysign" "float"
 external mod_float : float -> float -> float = "caml_fmod_float" "fmod" "float"
 external frexp : float -> float * int = "caml_frexp_float"
 external ldexp : float -> int -> float = "caml_ldexp_float"
@@ -214,7 +215,8 @@ let rec ( @ ) l1 l2 =
 type in_channel
 type out_channel
 
-external open_descriptor_out : int -> out_channel = "caml_ml_open_descriptor_out"
+external open_descriptor_out : int -> out_channel
+                             = "caml_ml_open_descriptor_out"
 external open_descriptor_in : int -> in_channel = "caml_ml_open_descriptor_in"
 
 let stdin = open_descriptor_in 0
diff --git a/stdlib/pervasives.mli b/stdlib/pervasives.mli
index d2141cd74a..9da56a2615 100644
--- a/stdlib/pervasives.mli
+++ b/stdlib/pervasives.mli
@@ -229,7 +229,7 @@ external ( asr ) : int -> int -> int = "%asrint"
 
 (** {6 Floating-point arithmetic}
 
-   Caml's floating-point numbers follow the
+   OCaml's floating-point numbers follow the
    IEEE 754 standard, using double precision (64 bits) numbers.
    Floating-point operations never raise an exception on overflow,
    underflow, division by zero, etc.  Instead, special IEEE numbers
@@ -314,7 +314,8 @@ external atan2 : float -> float -> float = "caml_atan2_float" "atan2" "float"
     and [y] are used to determine the quadrant of the result.
     Result is in radians and is between [-pi] and [pi]. *)
 
-external hypot : float -> float -> float = "caml_hypot_float" "caml_hypot" "float"
+external hypot : float -> float -> float
+               = "caml_hypot_float" "caml_hypot" "float"
 (** [hypot x y] returns [sqrt(x *. x + y *. y)], that is, the length
   of the hypotenuse of a right-angled triangle with sides of length
   [x] and [y], or, equivalently, the distance of the point [(x,y)]
@@ -344,11 +345,13 @@ external floor : float -> float = "caml_floor_float" "floor" "float"
 external abs_float : float -> float = "%absfloat"
 (** [abs_float f] returns the absolute value of [f]. *)
 
-external copysign : float -> float -> float = "caml_copysign_float" "caml_copysign" "float"
+external copysign : float -> float -> float
+                  = "caml_copysign_float" "caml_copysign" "float"
 (** [copysign x y] returns a float whose absolute value is that of [x]
   and whose sign is that of [y].  If [x] is [nan], returns [nan].
   If [y] is [nan], returns either [x] or [-. x], but it is not
-  specified which.  *)
+  specified which.
+  @since 3.13.0  *)
 
 external mod_float : float -> float -> float = "caml_fmod_float" "fmod" "float"
 (** [mod_float a b] returns the remainder of [a] with respect to
diff --git a/stdlib/printf.ml b/stdlib/printf.ml
index afca2034ee..c55c64d367 100644
--- a/stdlib/printf.ml
+++ b/stdlib/printf.ml
@@ -217,7 +217,7 @@ let iter_on_format_args fmt add_conv add_char =
   and scan_conv skip i =
     if i > lim then incomplete_format fmt else
     match Sformat.unsafe_get fmt i with
-    | '%' | '!' | ',' -> succ i
+    | '%' | '@' | '!' | ',' -> succ i
     | 's' | 'S' | '[' -> add_conv skip i 's'
     | 'c' | 'C' -> add_conv skip i 'c'
     | 'd' | 'i' |'o' | 'u' | 'x' | 'X' | 'N' -> add_conv skip i 'i'
@@ -391,7 +391,7 @@ type positional_specification =
    with $n$ being the {\em value} of the integer argument defining [*]; we
    clearly cannot statically guess the value of this parameter in the general
    case. Put it another way: this means type dependency, which is completely
-   out of scope of the Caml type algebra. *)
+   out of scope of the OCaml type algebra. *)
 
 let scan_positional_spec fmt got_spec i =
   match Sformat.unsafe_get fmt i with
@@ -430,7 +430,7 @@ let get_index spec n =
   | Spec_index p -> p
 ;;
 
-(* Format a float argument as a valid Caml lexeme. *)
+(* Format a float argument as a valid OCaml lexeme. *)
 let format_float_lexeme =
 
   (* To be revised: this procedure should be a unique loop that performs the
@@ -443,7 +443,7 @@ let format_float_lexeme =
   let make_valid_float_lexeme s =
     (* Check if s is already a valid lexeme:
        in this case do nothing,
-       otherwise turn s into a valid Caml lexeme. *)
+       otherwise turn s into a valid OCaml lexeme. *)
     let l = String.length s in
     let rec valid_float_loop i =
       if i >= l then s ^ "." else
@@ -505,8 +505,10 @@ let scan_format fmt args n pos cont_s cont_a cont_t cont_f cont_m =
 
   and scan_conv spec n widths i =
     match Sformat.unsafe_get fmt i with
-    | '%' ->
-      cont_s n "%" (succ i)
+    | '%' | '@' as c ->
+      cont_s n (String.make 1 c) (succ i)
+    | '!' -> cont_f n (succ i)
+    | ',' -> cont_s n "" (succ i)
     | 's' | 'S' as conv ->
       let (x : string) = get_arg spec n in
       let x = if conv = 's' then x else "\"" ^ String.escaped x ^ "\"" in
@@ -515,6 +517,8 @@ let scan_format fmt args n pos cont_s cont_a cont_t cont_f cont_m =
         if i = succ pos then x else
         format_string (extract_format fmt pos i widths) x in
       cont_s (next_index spec n) s (succ i)
+    | '[' as conv ->
+      bad_conversion_format fmt i conv
     | 'c' | 'C' as conv ->
       let (x : char) = get_arg spec n in
       let s =
@@ -546,6 +550,8 @@ let scan_format fmt args n pos cont_s cont_a cont_t cont_f cont_m =
       let n = Sformat.succ_index (get_index spec n) in
       let arg = get_arg Spec_none n in
       cont_a (next_index spec n) printer arg (succ i)
+    | 'r' as conv ->
+      bad_conversion_format fmt i conv
     | 't' ->
       let printer = get_arg spec n in
       cont_t (next_index spec n) printer (succ i)
@@ -570,8 +576,6 @@ let scan_format fmt args n pos cont_s cont_a cont_t cont_f cont_m =
         let s = format_int (extract_format_int 'n' fmt pos i widths) x in
         cont_s (next_index spec n) s (succ i)
       end
-    | ',' -> cont_s n "" (succ i)
-    | '!' -> cont_f n (succ i)
     | '{' | '(' as conv (* ')' '}' *) ->
       let (xf : ('a, 'b, 'c, 'd, 'e, 'f) format6) = get_arg spec n in
       let i = succ i in
@@ -670,7 +674,7 @@ let sprintf fmt = ksprintf (fun s -> s) fmt;;
 (* Obsolete and deprecated. *)
 let kprintf = ksprintf;;
 
-(* For Caml system internal use only: needed to implement modules [Format]
+(* For OCaml system internal use only: needed to implement modules [Format]
   and [Scanf]. *)
 
 module CamlinternalPr = struct
diff --git a/stdlib/printf.mli b/stdlib/printf.mli
index 797a354dd0..942ec49b05 100644
--- a/stdlib/printf.mli
+++ b/stdlib/printf.mli
@@ -20,7 +20,7 @@ val fprintf : out_channel -> ('a, out_channel, unit) format -> 'a
    [arg1] to [argN] according to the format string [format], and
    outputs the resulting string on the channel [outchan].
 
-   The format is a character string which contains two types of
+   The format string is a character string which contains two types of
    objects: plain characters, which are simply copied to the output
    channel, and conversion specifications, each of which causes
    conversion and printing of arguments.
@@ -31,60 +31,66 @@ val fprintf : out_channel -> ('a, out_channel, unit) format -> 'a
 
    In short, a conversion specification consists in the [%] character,
    followed by optional modifiers and a type which is made of one or
-   two characters. The types and their meanings are:
+   two characters.
 
-   - [d], [i], [n], [l], [L], or [N]: convert an integer argument to
-     signed decimal.
-   - [u]: convert an integer argument to unsigned decimal.
+   The types and their meanings are:
+
+   - [d], [i]: convert an integer argument to signed decimal.
+   - [u], [n], [l], [L], or [N]: convert an integer argument to
+     unsigned decimal.  Warning: [n], [l], [L], and [N] are
+     used for [scanf], and should not be used for [printf].
    - [x]: convert an integer argument to unsigned hexadecimal,
      using lowercase letters.
    - [X]: convert an integer argument to unsigned hexadecimal,
      using uppercase letters.
    - [o]: convert an integer argument to unsigned octal.
    - [s]: insert a string argument.
-   - [S]: insert a string argument in Caml syntax (double quotes, escapes).
+   - [S]: convert a string argument to OCaml syntax (double quotes, escapes).
    - [c]: insert a character argument.
-   - [C]: insert a character argument in Caml syntax (single quotes, escapes).
+   - [C]: convert a character argument to OCaml syntax (single quotes, escapes).
    - [f]: convert a floating-point argument to decimal notation,
      in the style [dddd.ddd].
-   - [F]: convert a floating-point argument to Caml syntax ([dddd.]
+   - [F]: convert a floating-point argument to OCaml syntax ([dddd.]
      or [dddd.ddd] or [d.ddd e+-dd]).
    - [e] or [E]: convert a floating-point argument to decimal notation,
      in the style [d.ddd e+-dd] (mantissa and exponent).
    - [g] or [G]: convert a floating-point argument to decimal notation,
      in style [f] or [e], [E] (whichever is more compact).
    - [B]: convert a boolean argument to the string [true] or [false]
-   - [b]: convert a boolean argument (for backward compatibility; do not
-     use in new programs).
+   - [b]: convert a boolean argument (deprecated; do not use in new
+     programs).
    - [ld], [li], [lu], [lx], [lX], [lo]: convert an [int32] argument to
      the format specified by the second letter (decimal, hexadecimal, etc).
    - [nd], [ni], [nu], [nx], [nX], [no]: convert a [nativeint] argument to
      the format specified by the second letter.
    - [Ld], [Li], [Lu], [Lx], [LX], [Lo]: convert an [int64] argument to
      the format specified by the second letter.
-   - [a]: user-defined printer. Takes two arguments and applies the
+   - [a]: user-defined printer. Take two arguments and apply the
      first one to [outchan] (the current output channel) and to the
      second argument. The first argument must therefore have type
      [out_channel -> 'b -> unit] and the second ['b].
      The output produced by the function is inserted in the output of
      [fprintf] at the current point.
-   - [t]: same as [%a], but takes only one argument (with type
+   - [t]: same as [%a], but take only one argument (with type
      [out_channel -> unit]) and apply it to [outchan].
    - [\{ fmt %\}]: convert a format string argument. The argument must
      have the same type as the internal format string [fmt].
-   - [( fmt %)]: format string substitution. Takes a format string
-     argument and substitutes it to the internal format string [fmt]
+   - [( fmt %)]: format string substitution. Take a format string
+     argument and substitute it to the internal format string [fmt]
      to print following arguments. The argument must have the same
      type as the internal format string [fmt].
    - [!]: take no argument and flush the output.
    - [%]: take no argument and output one [%] character.
-   - [,]: the no-op delimiter for conversion specifications.
+   - [\@]: take no argument and output one [\@] character.
+   - [,]: take no argument and do nothing.
 
    The optional [flags] are:
    - [-]: left-justify the output (default is right justification).
    - [0]: for numerical conversions, pad with zeroes instead of spaces.
-   - [+]: for numerical conversions, prefix number with a [+] sign if positive.
-   - space: for numerical conversions, prefix number with a space if positive.
+   - [+]: for signed numerical conversions, prefix number with a [+]
+     sign if positive.
+   - space: for signed numerical conversions, prefix number with a
+     space if positive.
    - [#]: request an alternate formatting style for numbers.
 
    The optional [width] is an integer indicating the minimal
@@ -153,7 +159,7 @@ val kprintf : (string -> 'a) -> ('b, unit, string, 'a) format4 -> 'b;;
 
 (**/**)
 
-(* For Caml system internal use only. Don't call directly. *)
+(* For OCaml system internal use only. Don't call directly. *)
 
 module CamlinternalPr : sig
 
diff --git a/stdlib/queue.ml b/stdlib/queue.ml
index 605a892046..4e12eb3d2f 100644
--- a/stdlib/queue.ml
+++ b/stdlib/queue.ml
@@ -15,7 +15,7 @@
 
 exception Empty
 
-(* O'Caml currently does not allow the components of a sum type to be
+(* OCaml currently does not allow the components of a sum type to be
    mutable. Yet, for optimal space efficiency, we must have cons cells
    whose [next] field is mutable. This leads us to define a type of
    cyclic lists, so as to eliminate the [Nil] case and the sum
diff --git a/stdlib/scanf.ml b/stdlib/scanf.ml
index ee80f5e7a6..9c6ecef62f 100644
--- a/stdlib/scanf.ml
+++ b/stdlib/scanf.ml
@@ -438,7 +438,7 @@ let int_of_width_opt = function
 ;;
 
 let int_of_prec_opt = function
-  | None -> 0
+  | None -> max_int
   | Some prec -> prec
 ;;
 
@@ -737,7 +737,7 @@ let scan_exp_part width ib =
 ;;
 
 (* Scan the integer part of a floating point number, (not using the
-   Caml lexical convention since the integer part can be empty):
+   OCaml lexical convention since the integer part can be empty):
    an optional sign, followed by a possibly empty sequence of decimal
    digits (e.g. -.1). *)
 let scan_int_part width ib =
@@ -925,7 +925,7 @@ let scan_backslash_char width ib =
     bad_input_escape c
 ;;
 
-(* Scan a character (a Caml token). *)
+(* Scan a character (an OCaml token). *)
 let scan_Char width ib =
 
   let rec find_start width =
@@ -946,7 +946,7 @@ let scan_Char width ib =
   find_start width
 ;;
 
-(* Scan a delimited string (a Caml token). *)
+(* Scan a delimited string (an OCaml token). *)
 let scan_String width ib =
 
   let rec find_start width =
@@ -979,7 +979,7 @@ let scan_String width ib =
   find_start width
 ;;
 
-(* Scan a boolean (a Caml token). *)
+(* Scan a boolean (an OCaml token). *)
 let scan_bool width ib =
   if width < 4 then bad_token_length "a boolean" else
   let c = Scanning.checked_peek_char ib in
@@ -999,31 +999,51 @@ type char_set =
    | Neg_set of string (* Negative (complementary) set. *)
 ;;
 
+
 (* Char sets are read as sub-strings in the format string. *)
-let read_char_set fmt i =
-  let lim = Sformat.length fmt - 1 in
+let scan_range fmt j =
+
+  let len = Sformat.length fmt in
+
+  let buffer = Buffer.create len in
 
-  let rec find_in_set j =
-    if j > lim then incomplete_format fmt else
+  let rec scan_closing j =
+    if j >= len then incomplete_format fmt else
     match Sformat.get fmt j with
-    | ']' -> j
-    | _ -> find_in_set (succ j)
-
-  and find_set i =
-    if i > lim then incomplete_format fmt else
-    match Sformat.get fmt i with
-    | ']' -> find_in_set (succ i)
-    | _ -> find_in_set i in
-
-  if i > lim then incomplete_format fmt else
-  match Sformat.get fmt i with
-  | '^' ->
-    let i = succ i in
-    let j = find_set i in
-    j, Neg_set (Sformat.sub fmt (Sformat.index_of_int i) (j - i))
-  | _ ->
-    let j = find_set i in
-    j, Pos_set (Sformat.sub fmt (Sformat.index_of_int i) (j - i))
+    | ']' -> j, Buffer.contents buffer
+    | '%' ->
+      let j = j + 1 in
+      if j >= len then incomplete_format fmt else
+      begin match Sformat.get fmt j with
+      | '%' | '@' as c ->
+        Buffer.add_char buffer c;
+        scan_closing (j + 1)
+      | c -> bad_conversion fmt j c
+      end
+    | c ->
+      Buffer.add_char buffer c;
+      scan_closing (j + 1) in
+
+  let scan_first_pos j =
+    if j >= len then incomplete_format fmt else
+    match Sformat.get fmt j with
+    | ']' as c ->
+      Buffer.add_char buffer c;
+      scan_closing (j + 1)
+    | _ -> scan_closing j in
+
+  let rec scan_first_neg j =
+    if j >= len then incomplete_format fmt else
+    match Sformat.get fmt j with
+    | '^' ->
+      let j = j + 1 in
+      let k, char_set = scan_first_pos j in
+      k, Neg_set char_set
+    | _ ->
+      let k, char_set = scan_first_pos j in
+      k, Pos_set char_set in
+
+  scan_first_neg j
 ;;
 
 (* Char sets are now represented as bit vectors that are represented as
@@ -1370,18 +1390,19 @@ let scan_format ib ef fmt rv f =
       let width = int_of_width_opt width_opt in
       let prec = int_of_prec_opt prec_opt in
       match Sformat.get fmt i with
-      | '%' as conv ->
-        check_char ib conv; scan_fmt ir f (succ i)
+      | '%' | '@' as c ->
+        check_char ib c;
+        scan_fmt ir f (succ i)
       | 's' ->
-        let i, stp = scan_fmt_stoppers (succ i) in
+        let i, stp = scan_indication (succ i) in
         let _x = scan_string stp width ib in
         scan_fmt ir (stack f (token_string ib)) (succ i)
       | 'S' ->
         let _x = scan_String width ib in
         scan_fmt ir (stack f (token_string ib)) (succ i)
       | '[' (* ']' *) ->
-        let i, char_set = read_char_set fmt (succ i) in
-        let i, stp = scan_fmt_stoppers (succ i) in
+        let i, char_set = scan_range fmt (succ i) in
+        let i, stp = scan_indication (succ i) in
         let _x = scan_chars_in_char_set stp char_set width ib in
         scan_fmt ir (stack f (token_string ib)) (succ i)
       | ('c' | 'C') when width = 0 ->
@@ -1458,12 +1479,23 @@ let scan_format ib ef fmt rv f =
 
       | c -> bad_conversion fmt i c
 
-    and scan_fmt_stoppers i =
-      if i > lim then i - 1, [] else
-      match Sformat.get fmt i with
-      | '@' when i < lim -> let i = succ i in i, [Sformat.get fmt i]
-      | '@' when i = lim -> incomplete_format fmt
-      | _ -> i - 1, [] in
+    and scan_indication j =
+      if j > lim then j - 1, [] else
+      match Sformat.get fmt j with
+      | '@' ->
+        let k = j + 1 in
+        if k > lim then j - 1, [] else
+        begin match Sformat.get fmt k with
+        | '%' ->
+          let k = k + 1 in
+          if k > lim then j - 1, [] else
+          begin match Sformat.get fmt k with
+          | '%' | '@' as c  -> k, [ c ]
+          | _c -> j - 1, []
+          end
+        | c -> k, [ c ]
+        end
+      | _c -> j - 1, [] in
 
     scan_fmt in
 
@@ -1488,7 +1520,8 @@ let bscanf ib = kscanf ib scanf_bad_input;;
 
 let fscanf ic = bscanf (Scanning.from_channel ic);;
 
-let sscanf s = bscanf (Scanning.from_string s);;
+let sscanf : string -> ('a, 'b, 'c, 'd) scanner
+  = fun s -> bscanf (Scanning.from_string s);;
 
 let scanf fmt = bscanf Scanning.stdib fmt;;
 
@@ -1521,6 +1554,9 @@ 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)
+
 (*
  Local Variables:
   compile-command: "cd ..; make world"
diff --git a/stdlib/scanf.mli b/stdlib/scanf.mli
index 1e8a744840..53317d66d8 100644
--- a/stdlib/scanf.mli
+++ b/stdlib/scanf.mli
@@ -65,16 +65,16 @@
 
 (** {7 Formatted input as a functional feature} *)
 
-(** The Caml scanning facility is reminiscent of the corresponding C feature.
+(** The OCaml scanning facility is reminiscent of the corresponding C feature.
     However, it is also largely different, simpler, and yet more powerful:
     the formatted input functions are higher-order functionals and the
     parameter passing mechanism is just the regular function application not
     the variable assignment based mechanism which is typical for formatted
-    input in imperative languages; the Caml format strings also feature
+    input in imperative languages; the OCaml format strings also feature
     useful additions to easily define complex tokens; as expected within a
     functional programming language, the formatted input functions also
     support polymorphism, in particular arbitrary interaction with
-    polymorphic user-defined scanners.  Furthermore, the Caml formatted input
+    polymorphic user-defined scanners.  Furthermore, the OCaml formatted input
     facility is fully type-checked at compile time. *)
 
 (** {6 Formatted input channel} *)
@@ -232,21 +232,14 @@ val bscanf : Scanning.in_channel -> ('a, 'b, 'c, 'd) scanner;;
 
 (** {6 Format string description} *)
 
-(** The format string is a character string which contains three types of
+(** The format is a character string which contains three types of
     objects:
     - plain characters, which are simply matched with the characters of the
       input (with a special case for space and line feed, see {!Scanf.space}),
     - conversion specifications, each of which causes reading and conversion of
       one argument for the function [f] (see {!Scanf.conversion}),
     - scanning indications to specify boundaries of tokens
-      (see scanning {!Scanf.indication}).
-
-   As a special convention for format strings, the [\@] character introduces
-   an escape for both characters [\@] and [%]: in a format string,
-   [\@\@] and [\@%] are respectively equivalent to the plain characters [\@]
-   and [%].
-   @since 3.13
-*)
+      (see scanning {!Scanf.indication}). *)
 
 (** {7:space The space character in format strings} *)
 
@@ -269,157 +262,148 @@ val bscanf : Scanning.in_channel -> ('a, 'b, 'c, 'd) scanner;;
 
 (** {7:conversion Conversion specifications in format strings} *)
 
-(** Conversion specifications have the following form:
-
-   [% \[flags\] \[width\] \[.precision\] type]
-
-   In short, a conversion specification consists in the [%] character,
-   followed by optional modifiers, and a type which is made of one or
-   several characters.
-
-   The types and their meanings are:
-
-   - [d]: reads an optionally signed decimal integer.
-   - [i]: reads an optionally signed integer
-     (usual input conventions for decimal ([0-9]+), hexadecimal
-      ([0x[0-9a-f]+] and [0X[0-9A-F]+]), octal ([0o[0-7]+]), and binary
-      ([0b[0-1]+]) notations are understood).
-   - [u]: reads an unsigned decimal integer.
-   - [x] or [X]: reads an unsigned hexadecimal integer ([[0-9a-f]+] or [[0-9A-F]+]).
-   - [o]: reads an unsigned octal integer ([[0-7]+]).
-   - [s]: reads a string argument that spreads as much as possible, until
-     the following bounding conditions holds:
-     {ul
-       {- a whitespace has been found (see {!Scanf.space}),}
-       {- a scanning indication has been encountered
-          (see scanning {!Scanf.indication}),}
-       {- the end-of-input has been reached.}
-     }
-     Hence, the [%s] conversion always succeeds: it returns an empty
-     string, if the bounding condition holds when the scan begins.
-   - [S]: reads a delimited string argument (delimiters and special
-     escaped characters follow the lexical conventions of Caml).
-   - [c]: reads a single character. To test the current input character
-     without reading it, specify a null field width, i.e. use
-     specification [%0c]. Raise [Invalid_argument], if the field width
-     specification is greater than 1.
-   - [C]: reads a single delimited character (delimiters and special
-     escaped characters follow the lexical conventions of Caml).
-   - [f], [e], [E], [g], [G]: reads an optionally signed
-     floating-point number in decimal notation, in the style [dddd.ddd
-     e/E+-dd].
-   - [F]: reads a floating point number according to the lexical
-     conventions of Caml (hence the decimal point is mandatory if the
-     exponent part is not mentioned).
-   - [B]: reads a boolean argument ([true] or [false]).
-   - [b]: reads a boolean argument (for backward compatibility; do not use
-     in new programs).
-   - [ld], [li], [lu], [lx], [lX], [lo]: reads an [int32] argument to
-     the format specified by the second letter for regular integers.
-   - [nd], [ni], [nu], [nx], [nX], [no]: reads a [nativeint] argument to
-     the format specified by the second letter for regular integers.
-   - [Ld], [Li], [Lu], [Lx], [LX], [Lo]: reads an [int64] argument to
-     the format specified by the second letter for regular integers.
-   - [\[ range \]]: reads characters that matches one of the characters
-     mentioned in the range of characters [range] (or not mentioned in
-     it, if the range starts with [^]). Reads a [string] that can be
-     empty, if the next input character does not match the range. The set of
-     characters from [c1] to [c2] (inclusively) is denoted by [c1-c2].
-     Hence, [%\[0-9\]] returns a string representing a decimal number
-     or an empty string if no decimal digit is found; similarly,
-     [%\[\\048-\\057\\065-\\070\]] returns a string of hexadecimal digits.
-     If a closing bracket appears in a range, it must occur as the
-     first character of the range (or just after the [^] in case of
-     range negation); hence [\[\]\]] matches a [\]] character and
-     [\[^\]\]] matches any character that is not [\]].
-   - [r]: user-defined reader. Takes the next [ri] formatted input function and
-     applies it to the scanning buffer [ib] to read the next argument. The
-     input function [ri] must therefore have type [Scanning.in_channel -> 'a] and
-     the argument read has type ['a].
-   - [\{ fmt %\}]: reads a format string argument.
-     The format string read must have the same type as the format string
-     specification [fmt].
-     For instance, ["%{ %i %}"] reads any format string that can read a value of
-     type [int]; hence, if [s] is the string ["fmt:\"number is %u\""], then
-     [Scanf.sscanf s "fmt: %{%i%}"] succeeds and returns the format string
-     ["number is %u"].
-   - [\( fmt %\)]: scanning format substitution.
-     Reads a format string and then goes on scanning with the format string
-     read, instead of using [fmt].
-     The format string read must have the same type as the format string
-     specification [fmt] that it replaces.
-     For instance, ["%( %i %)"] reads any format string that can read a value
-     of type [int].
-     Returns the format string read, and the value read using the format
-     string read.
-     Hence, if [s] is the string ["\"%4d\"1234.00"], then
-     [Scanf.sscanf s "%(%i%)" (fun fmt i -> fmt, i)] evaluates to
-     [("%4d", 1234)].
-     If the special flag [_] is used, the conversion discards the
-     format string read and only returns the value read with the format
-     string read.
-     Hence, if [s] is the string ["\"%4d\"1234.00"], then
-     [Scanf.sscanf s "%_(%i%)"] is simply equivalent to
-     [Scanf.sscanf "1234.00" "%4d"].
-   - [l]: returns the number of lines read so far.
-   - [n]: returns the number of characters read so far.
-   - [N] or [L]: returns the number of tokens read so far.
-   - [!]: matches the end of input condition.
-   - [%]: matches one [%] character in the input.
-   - [,]: the no-op delimiter for conversion specifications.
-
-   Following the [%] character that introduces a conversion, there may be
-   the special flag [_]: the conversion that follows occurs as usual,
-   but the resulting value is discarded.
-   For instance, if [f] is the function [fun i -> i + 1], and [s] is the
-   string ["x = 1"], then [Scanf.sscanf s "%_s = %i" f] returns [2].
-
-   The optional [width] is an integer literal indicating the maximal width
-   of the token to read.
-   For instance, [%6d] reads an integer, having at most 6 decimal digits;
-   [%4f] reads a float with at most 4 characters; and [%8\[\\000-\\255\]]
-   returns the next 8 characters (or all the characters still available,
-   if fewer than 8 characters are available in the input).
-
-   The optional [precision] is a dot [.] followed by an integer literal
-   indicating the maximum number of digits that follow the decimal point in
-   the [%f], [%e], and [%E] conversions. For instance, [%.4f] reads a
-   [float] with at most 4 fractional digits.
-
-   Notes:
-
-   - as mentioned above, the [%s] conversion always succeeds, even if there is
-     nothing to read in the input: in this case, it simply returns [""].
-
-   - in addition to the relevant digits, ['_'] characters may appear
-   inside numbers (this is reminiscent to the usual Caml lexical
-   conventions). If stricter scanning is desired, use the range
-   conversion facility instead of the number conversions.
-
-   - the [scanf] facility is not intended for heavy duty lexical
-   analysis and parsing. If it appears not expressive enough for your
-   needs, several alternative exists: regular expressions (module
-   [Str]), stream parsers, [ocamllex]-generated lexers,
-   [ocamlyacc]-generated parsers. *)
+(** Conversion specifications consist in the [%] character, followed by
+    an optional flag, an optional field width, and followed by one or
+    two conversion characters. The conversion characters and their
+    meanings are:
+
+    - [d]: reads an optionally signed decimal integer.
+    - [i]: reads an optionally signed integer
+      (usual input conventions for decimal ([0-9]+), hexadecimal
+       ([0x[0-9a-f]+] and [0X[0-9A-F]+]), octal ([0o[0-7]+]), and binary
+       ([0b[0-1]+]) notations are understood).
+    - [u]: reads an unsigned decimal integer.
+    - [x] or [X]: reads an unsigned hexadecimal integer ([[0-9a-fA-F]+]).
+    - [o]: reads an unsigned octal integer ([[0-7]+]).
+    - [s]: reads a string argument that spreads as much as possible, until the
+      following bounding condition holds: {ul
+      {- a whitespace has been found (see {!Scanf.space}),}
+      {- a scanning indication (see scanning {!Scanf.indication}) has been
+         encountered,}
+      {- the end-of-input has been reached.}}
+      Hence, this conversion always succeeds: it returns an empty
+      string, if the bounding condition holds when the scan begins.
+    - [S]: reads a delimited string argument (delimiters and special
+      escaped characters follow the lexical conventions of Caml).
+    - [c]: reads a single character. To test the current input character
+      without reading it, specify a null field width, i.e. use
+      specification [%0c]. Raise [Invalid_argument], if the field width
+      specification is greater than 1.
+    - [C]: reads a single delimited character (delimiters and special
+      escaped characters follow the lexical conventions of Caml).
+    - [f], [e], [E], [g], [G]: reads an optionally signed
+      floating-point number in decimal notation, in the style [dddd.ddd
+      e/E+-dd].
+    - [F]: reads a floating point number according to the lexical
+      conventions of Caml (hence the decimal point is mandatory if the
+      exponent part is not mentioned).
+    - [B]: reads a boolean argument ([true] or [false]).
+    - [b]: reads a boolean argument (for backward compatibility; do not use
+      in new programs).
+    - [ld], [li], [lu], [lx], [lX], [lo]: reads an [int32] argument to
+      the format specified by the second letter for regular integers.
+    - [nd], [ni], [nu], [nx], [nX], [no]: reads a [nativeint] argument to
+      the format specified by the second letter for regular integers.
+    - [Ld], [Li], [Lu], [Lx], [LX], [Lo]: reads an [int64] argument to
+      the format specified by the second letter for regular integers.
+    - [\[ range \]]: reads characters that matches one of the characters
+      mentioned in the range of characters [range] (or not mentioned in
+      it, if the range starts with [^]). Reads a [string] that can be
+      empty, if the next input character does not match the range. The set of
+      characters from [c1] to [c2] (inclusively) is denoted by [c1-c2].
+      Hence, [%\[0-9\]] returns a string representing a decimal number
+      or an empty string if no decimal digit is found; similarly,
+      [%\[\\048-\\057\\065-\\070\]] returns a string of hexadecimal digits.
+      If a closing bracket appears in a range, it must occur as the
+      first character of the range (or just after the [^] in case of
+      range negation); hence [\[\]\]] matches a [\]] character and
+      [\[^\]\]] matches any character that is not [\]].
+      Use [%%] and [%\@] to include a [%] or a [\@] in a range.
+    - [r]: user-defined reader. Takes the next [ri] formatted input function and
+      applies it to the scanning buffer [ib] to read the next argument. The
+      input function [ri] must therefore have type [Scanning.in_channel -> 'a] and
+      the argument read has type ['a].
+    - [\{ fmt %\}]: reads a format string argument.
+      The format string read must have the same type as the format string
+      specification [fmt].
+      For instance, ["%{ %i %}"] reads any format string that can read a value of
+      type [int]; hence, if [s] is the string ["fmt:\"number is %u\""], then
+      [Scanf.sscanf s "fmt: %{%i%}"] succeeds and returns the format string
+      ["number is %u"].
+    - [\( fmt %\)]: scanning format substitution.
+      Reads a format string and then goes on scanning with the format string
+      read, instead of using [fmt].
+      The format string read must have the same type as the format string
+      specification [fmt] that it replaces.
+      For instance, ["%( %i %)"] reads any format string that can read a value
+      of type [int].
+      Returns the format string read, and the value read using the format
+      string read.
+      Hence, if [s] is the string ["\"%4d\"1234.00"], then
+      [Scanf.sscanf s "%(%i%)" (fun fmt i -> fmt, i)] evaluates to
+      [("%4d", 1234)].
+      If the special flag [_] is used, the conversion discards the
+      format string read and only returns the value read with the format
+      string read.
+      Hence, if [s] is the string ["\"%4d\"1234.00"], then
+      [Scanf.sscanf s "%_(%i%)"] is simply equivalent to
+      [Scanf.sscanf "1234.00" "%4d"].
+    - [l]: returns the number of lines read so far.
+    - [n]: returns the number of characters read so far.
+    - [N] or [L]: returns the number of tokens read so far.
+    - [!]: matches the end of input condition.
+    - [%]: matches one [%] character in the input.
+    - [\@]: matches one [\@] character in the input.
+    - [,]: does nothing.
+
+    Following the [%] character that introduces a conversion, there may be
+    the special flag [_]: the conversion that follows occurs as usual,
+    but the resulting value is discarded.
+    For instance, if [f] is the function [fun i -> i + 1], and [s] is the
+    string ["x = 1"], then [Scanf.sscanf s "%_s = %i" f] returns [2].
+
+    The field width is composed of an optional integer literal
+    indicating the maximal width of the token to read.
+    For instance, [%6d] reads an integer, having at most 6 decimal digits;
+    [%4f] reads a float with at most 4 characters; and [%8[\\000-\\255]]
+    returns the next 8 characters (or all the characters still available,
+    if fewer than 8 characters are available in the input).
+
+    Notes:
+
+    - as mentioned above, a [%s] conversion always succeeds, even if there is
+      nothing to read in the input: in this case, it simply returns [""].
+
+    - in addition to the relevant digits, ['_'] characters may appear
+    inside numbers (this is reminiscent to the usual Caml lexical
+    conventions). If stricter scanning is desired, use the range
+    conversion facility instead of the number conversions.
+
+    - the [scanf] facility is not intended for heavy duty lexical
+    analysis and parsing. If it appears not expressive enough for your
+    needs, several alternative exists: regular expressions (module
+    [Str]), stream parsers, [ocamllex]-generated lexers,
+    [ocamlyacc]-generated parsers. *)
 
 (** {7:indication Scanning indications in format strings} *)
 
 (** Scanning indications appear just after the string conversions [%s]
-    and [%\[ range \]] to delimit the end of the token. A scanning
+    and [%[ range ]] to delimit the end of the token. A scanning
     indication is introduced by a [\@] character, followed by some
-    literal character [c]. It means that the string token should end
+    plain character [c]. It means that the string token should end
     just before the next matching [c] (which is skipped). If no [c]
     character is encountered, the string token spreads as much as
     possible. For instance, ["%s@\t"] reads a string up to the next
-    tab character or up to the end of input.
-
-    When it does not introduce a scanning indication, the [\@] character
-    introduces an escape for the next character: [\@c] is treated as a plain
-    [c] character.
+    tab character or to the end of input. If a [\@] character appears
+    anywhere else in the format string, it is treated as a plain character.
 
     Note:
 
-    - the scanning indications introduce slight differences in the syntax of
+    - As usual in format strings, [%] characters must be escaped using [%%]
+      and [%\@] is equivalent to [\@]; this rule still holds within range
+      specifications and scanning indications.
+      For instance, ["%s@%%"] reads a string up to the next [%] character.
+    - The scanning indications introduce slight differences in the syntax of
     [Scanf] format strings, compared to those used for the [Printf]
     module. However, the scanning indications are similar to those used in
     the [Format] module; hence, when producing formatted text to be scanned
@@ -509,8 +493,10 @@ val format_from_string :
     @since 3.10.0
 *)
 
-(*
- Local Variables:
-  compile-command: "cd ..; make world"
-  End:
+val unescaped : string -> string
+(** Return a copy of the argument with escape sequences, following the
+    lexical conventions of OCaml, replaced by their corresponding
+    special characters.  If there is no escape sequence in the
+    argument, still return a copy, contrary to String.escaped.
+    @since 3.13.0
 *)
diff --git a/stdlib/set.ml b/stdlib/set.ml
index 63e965fa4f..e61fd24b6a 100644
--- a/stdlib/set.ml
+++ b/stdlib/set.ml
@@ -117,13 +117,32 @@ module Make(Ord: OrderedType) =
           if c = 0 then t else
           if c < 0 then bal (add x l) v r else bal l v (add x r)
 
+    let singleton x = Node(Empty, x, Empty, 1)
+
+    (* Beware: those two functions assume that the added v is *strictly*
+       smaller (or bigger) than all the present elements in the tree; it
+       does not test for equality with the current min (or max) element.
+       Indeed, they are only used during the "join" operation which
+       respects this precondition.
+    *)
+
+    let rec add_min_element v = function
+      | Empty -> singleton v
+      | Node (l, x, r, h) ->
+        bal (add_min_element v l) x r
+
+    let rec add_max_element v = function
+      | Empty -> singleton v
+      | Node (l, x, r, h) ->
+        bal l x (add_max_element v r)
+
     (* Same as create and bal, but no assumptions are made on the
        relative heights of l and r. *)
 
     let rec join l v r =
       match (l, r) with
-        (Empty, _) -> add v r
-      | (_, Empty) -> add v l
+        (Empty, _) -> add_min_element v r
+      | (_, Empty) -> add_max_element v l
       | (Node(ll, lv, lr, lh), Node(rl, rv, rr, rh)) ->
           if lh > rh + 2 then bal ll lv (join lr v r) else
           if rh > lh + 2 then bal (join l v rl) rv rr else
@@ -197,8 +216,6 @@ module Make(Ord: OrderedType) =
           let c = Ord.compare x v in
           c = 0 || mem x (if c < 0 then l else r)
 
-    let singleton x = Node(Empty, x, Empty, 1)
-
     let rec remove x = function
         Empty -> Empty
       | Node(l, v, r, _) ->
@@ -300,19 +317,19 @@ module Make(Ord: OrderedType) =
         Empty -> false
       | Node(l, v, r, _) -> p v || exists p l || exists p r
 
-    let filter p s =
-      let rec filt accu = function
-        | Empty -> accu
-        | Node(l, v, r, _) ->
-            filt (filt (if p v then add v accu else accu) l) r in
-      filt Empty s
-
-    let partition p s =
-      let rec part (t, f as accu) = function
-        | Empty -> accu
-        | Node(l, v, r, _) ->
-            part (part (if p v then (add v t, f) else (t, add v f)) l) r in
-      part (Empty, Empty) s
+    let rec filter p = function
+        Empty -> Empty
+      | Node(l, v, r, _) ->
+          let l' = filter p l and r' = filter p r in
+          if p v then join l' v r' else concat l' r'
+
+    let rec partition p = function
+        Empty -> (Empty, Empty)
+      | Node(l, v, r, _) ->
+          let (lt, lf) = partition p l and (rt, rf) = partition p r in
+          if p v
+          then (join lt v rt, concat lf rf)
+          else (concat lt rt, join lf v rf)
 
     let rec cardinal = function
         Empty -> 0
diff --git a/stdlib/string.mli b/stdlib/string.mli
index 3a7976bd20..501fb181c0 100644
--- a/stdlib/string.mli
+++ b/stdlib/string.mli
@@ -101,12 +101,17 @@ val iteri : (int -> char -> unit) -> string -> unit
    @since 3.13.0
 *)
 
+val map : (char -> char) -> string -> string
+(** [String.map f s] applies function [f] in turn to all
+   the characters of [s] and stores the results in a new string that
+   is returned. *)
+
 val escaped : string -> string
 (** Return a copy of the argument, with special characters
    represented by escape sequences, following the lexical
    conventions of OCaml.  If there is no special
    character in the argument, return the original string itself,
-   not a copy. *)
+   not a copy. Its inverse function is Scanf.unescaped. *)
 
 val index : string -> char -> int
 (** [String.index s c] returns the character number of the first
diff --git a/stdlib/sys.mli b/stdlib/sys.mli
index ee5021dcc1..4913bef8ee 100644
--- a/stdlib/sys.mli
+++ b/stdlib/sys.mli
@@ -75,13 +75,13 @@ val interactive : bool ref
    the interactive toplevel system [ocaml]. *)
 
 val os_type : string
-(** Operating system currently executing the Caml program. One of
+(** Operating system currently executing the OCaml program. One of
 -  ["Unix"] (for all Unix versions, including Linux and Mac OS X),
 -  ["Win32"] (for MS-Windows, OCaml compiled with MSVC++ or Mingw),
 -  ["Cygwin"] (for MS-Windows, OCaml compiled with Cygwin). *)
 
 val word_size : int
-(** Size of one word on the machine currently executing the Caml
+(** Size of one word on the machine currently executing the OCaml
    program, in bits: 32 or 64. *)
 
 val max_string_length : int
diff --git a/testsuite/makefiles/Makefile.common b/testsuite/makefiles/Makefile.common
index b4cb3ad035..151046a7a0 100644
--- a/testsuite/makefiles/Makefile.common
+++ b/testsuite/makefiles/Makefile.common
@@ -4,6 +4,7 @@ TOPDIR=$(BASEDIR)/..
 
 include $(TOPDIR)/config/Makefile
 
+DIFF=diff -q
 BOOTDIR=$(TOPDIR)/boot
 OCAMLRUN=$(BOOTDIR)/ocamlrun$(EXE)
 OCAML=$(OCAMLRUN) $(TOPDIR)/ocaml$(EXE) -I $(TOPDIR)/stdlib
diff --git a/testsuite/makefiles/Makefile.okbad b/testsuite/makefiles/Makefile.okbad
index 7f4ef7f698..9016dab3fe 100644
--- a/testsuite/makefiles/Makefile.okbad
+++ b/testsuite/makefiles/Makefile.okbad
@@ -10,7 +10,7 @@ compile:
 	  else \
 	    test -f `basename $$file ml`mli && $(OCAMLC) -c -w a `basename $$file ml`mli; \
 	    $(OCAMLC) -c -w a $$file 2> /dev/null || (echo " => failed" && exit 1); \
-	    test -f `basename $$file ml`reference && $(OCAMLC) `basename $$file ml`cmo && ./a.out > `basename $$file ml`result && (diff -q `basename $$file ml`reference `basename $$file ml`result || (echo " => failed" && exit 1)); \
+	    test -f `basename $$file ml`reference && $(OCAMLC) `basename $$file ml`cmo && ./a.out > `basename $$file ml`result && ($(DIFF) `basename $$file ml`reference `basename $$file ml`result || (echo " => failed" && exit 1)); \
 	    echo " => passed"; \
 	  fi; \
 	done
diff --git a/testsuite/makefiles/Makefile.one b/testsuite/makefiles/Makefile.one
index 53ac84888d..338b39460e 100644
--- a/testsuite/makefiles/Makefile.one
+++ b/testsuite/makefiles/Makefile.one
@@ -30,10 +30,10 @@ compile: $(ML_FILES) $(CMO_FILES) $(CMX_FILES) $(MAIN_MODULE).cmo $(MAIN_MODULE)
 run:
 	@printf " ... testing with ocamlc"
 	@./program.byte $(EXEC_ARGS) > $(MAIN_MODULE).result || (echo " => failed" && exit 1)
-	@diff -q $(MAIN_MODULE).reference $(MAIN_MODULE).result > /dev/null || (echo " => failed" && exit 1)
+	@$(DIFF) $(MAIN_MODULE).reference $(MAIN_MODULE).result > /dev/null || (echo " => failed" && exit 1)
 	@printf " ocamlopt"
 	@./program.native $(EXEC_ARGS) > $(MAIN_MODULE).result || (echo " => failed" && exit 1)
-	@diff -q $(MAIN_MODULE).reference $(MAIN_MODULE).result > /dev/null || (echo " => failed" && exit 1)
+	@$(DIFF) $(MAIN_MODULE).reference $(MAIN_MODULE).result > /dev/null || (echo " => failed" && exit 1)
 	@echo " => passed"
 
 promote: defaultpromote
diff --git a/testsuite/makefiles/Makefile.several b/testsuite/makefiles/Makefile.several
index 327e70997a..f22b3e6401 100644
--- a/testsuite/makefiles/Makefile.several
+++ b/testsuite/makefiles/Makefile.several
@@ -46,7 +46,7 @@ run-file:
 	@if [ -f `basename $(FILE) ml`checker ]; then \
 	  sh `basename $(FILE) ml`checker; \
 	else \
-	  diff -q `basename $(FILE) ml`reference `basename $(FILE) ml`result > /dev/null || (echo " => failed" && exit 1); \
+	  $(DIFF) `basename $(FILE) ml`reference `basename $(FILE) ml`result > /dev/null || (echo " => failed" && exit 1); \
 	fi
 
 promote: defaultpromote
diff --git a/testsuite/makefiles/Makefile.toplevel b/testsuite/makefiles/Makefile.toplevel
index 159a9a750d..532763f431 100644
--- a/testsuite/makefiles/Makefile.toplevel
+++ b/testsuite/makefiles/Makefile.toplevel
@@ -9,7 +9,7 @@ default:
 	done
 	@for file in *.reference; do \
 	  printf " ... testing '$$file':"; \
-	  diff -q $$file `basename $$file reference`result || (echo " => failed" && exit 1) && echo " => passed"; \
+	  $(DIFF) $$file `basename $$file reference`result || (echo " => failed" && exit 1) && echo " => passed"; \
 	done
 
 promote: defaultpromote
diff --git a/testsuite/tests/backtrace/Makefile b/testsuite/tests/backtrace/Makefile
index c4965c22c8..0d368bfc1f 100644
--- a/testsuite/tests/backtrace/Makefile
+++ b/testsuite/tests/backtrace/Makefile
@@ -7,7 +7,7 @@ run-all:
 	  for arg in a b c d ''; do \
 	    printf " ... testing '$$file' (with argument '$$arg'):"; \
 	    OCAMLRUNPARAM=b=1 $(EXECNAME) $$arg > `basename $$file ml`$$arg.result 2>&1; \
-	    diff -q `basename $$file ml`$$arg.reference `basename $$file ml`$$arg.result > /dev/null && echo " => passed" || (echo " => failed" && exit 1); \
+	    $(DIFF) `basename $$file ml`$$arg.reference `basename $$file ml`$$arg.result > /dev/null && echo " => passed" || (echo " => failed" && exit 1); \
 	  done; \
 	done
 
diff --git a/testsuite/tests/basic/arrays.ml b/testsuite/tests/basic/arrays.ml
index bbe8be3279..8dcf116623 100644
--- a/testsuite/tests/basic/arrays.ml
+++ b/testsuite/tests/basic/arrays.ml
@@ -46,7 +46,9 @@ let test2 () =
   if not (testcopy [|1.2;2.3;3.4;4.5|]) then
     print_string "Test2: failed on float array\n";
   if not (testcopy [|"un"; "deux"; "trois"|]) then
-    print_string "Test2: failed on string array\n"
+    print_string "Test2: failed on string array\n";
+  if not (testcopy (bigarray 42)) then
+    print_string "Test2: failed on big array\n"
 
 module AbstractFloat =
   (struct
@@ -79,8 +81,41 @@ let test3 () =
           AbstractFloat.to_float u.(2) = 3.0) then
     print_string "Test3: failed on u\n"
 
+let test4 () =
+  let a = bigarray 0 in
+  let b = Array.sub a 50 10 in
+  if b <> [| 50;51;52;53;54;55;56;57;58;59 |] then
+    print_string "Test4: failed\n"
+
+let test5 () =
+  if Array.append [| 1;2;3 |] [| 4;5 |] <> [| 1;2;3;4;5 |] then
+    print_string "Test5: failed on int arrays\n";
+  if Array.append [| 1.0;2.0;3.0 |] [| 4.0;5.0 |] <> [| 1.0;2.0;3.0;4.0;5.0 |] then
+    print_string "Test5: failed on float arrays\n"
+
+let test6 () =
+  let a = [| 0;1;2;3;4;5;6;7;8;9 |] in
+  let b = Array.concat [a;a;a;a;a;a;a;a;a;a] in
+  if not (Array.length b = 100 && b.(6) = 6 && b.(42) = 2 && b.(99) = 9) then
+    print_string "Test6: failed\n"
+
+let test7 () =
+  let a = Array.make 10 "a" in
+  let b = [| "b1"; "b2"; "b3" |] in
+  Array.blit b 0 a 5 3;
+  if a <> [|"a"; "a"; "a"; "a"; "a"; "b1"; "b2"; "b3"; "a"; "a"|]
+  || b <> [|"b1"; "b2"; "b3"|]
+  then print_string "Test7: failed(1)\n";
+  Array.blit a 5 a 6 4;
+  if a <> [|"a"; "a"; "a"; "a"; "a"; "b1"; "b1"; "b2"; "b3"; "a"|]
+  then print_string "Test7: failed(2)\n"
+
 let _ =
   test1();
   test2();
   test3();
+  test4();
+  test5();
+  test6();
+  test7();
   exit 0
diff --git a/testsuite/tests/callback/Makefile b/testsuite/tests/callback/Makefile
index bc846fe657..06ad39c50c 100644
--- a/testsuite/tests/callback/Makefile
+++ b/testsuite/tests/callback/Makefile
@@ -12,7 +12,7 @@ run-byte: common
 	@$(OCAMLC) -c tcallback.ml
 	@$(OCAMLC) -o ./program -custom unix.cma callbackprim.$(O) tcallback.cmo
 	@./program > bytecode.result
-	@diff -q reference bytecode.result || (echo " => failed" && exit 1) 
+	@$(DIFF) reference bytecode.result || (echo " => failed" && exit 1) 
 	@echo " => passed"
 
 run-opt: common
@@ -20,7 +20,7 @@ run-opt: common
 	@$(OCAMLOPT) -c tcallback.ml
 	@$(OCAMLOPT) -o ./program unix.cmxa callbackprim.$(O) tcallback.cmx
 	@./program > native.result
-	@diff -q reference native.result || (echo " => failed" && exit 1) 
+	@$(DIFF) reference native.result || (echo " => failed" && exit 1) 
 	@echo " => passed"
 	
 promote: defaultpromote
diff --git a/testsuite/tests/embedded/Makefile b/testsuite/tests/embedded/Makefile
index da50369f90..ed33143461 100644
--- a/testsuite/tests/embedded/Makefile
+++ b/testsuite/tests/embedded/Makefile
@@ -11,7 +11,7 @@ compile:
 run:
 	@printf " ... testing 'cmmain':"
 	@./program > program.result
-	@diff -q program.reference program.result > /dev/null || (echo " => failed" && exit 1)
+	@$(DIFF) program.reference program.result > /dev/null || (echo " => failed" && exit 1)
 	@echo " => passed"
 	
 promote: defaultpromote
diff --git a/testsuite/tests/letrec/Makefile b/testsuite/tests/letrec/Makefile
new file mode 100644
index 0000000000..bcc2fdb011
--- /dev/null
+++ b/testsuite/tests/letrec/Makefile
@@ -0,0 +1,4 @@
+BASEDIR=../..
+
+include $(BASEDIR)/makefiles/Makefile.several
+include $(BASEDIR)/makefiles/Makefile.common
diff --git a/testsuite/tests/letrec/backreferences.ml b/testsuite/tests/letrec/backreferences.ml
new file mode 100644
index 0000000000..4a893225b1
--- /dev/null
+++ b/testsuite/tests/letrec/backreferences.ml
@@ -0,0 +1,18 @@
+(* testing backreferences; some compilation scheme may handle
+   differently recursive references to a mutually-recursive RHS
+   depending on whether it is before or after in the bindings list *)
+type t = { x : t; y : t; z : t }
+
+let test =
+  let rec x = { x; y; z }
+      and y = { x; y; z }
+      and z = { x; y; z }
+  in
+  List.iter (fun (f, t_ref) ->
+    List.iter (fun t -> assert (f t == t_ref)) [x; y; z]
+  )
+    [
+      (fun t -> t.x), x;
+      (fun t -> t.y), y;
+      (fun t -> t.z), z;
+    ]
diff --git a/testsuite/tests/letrec/class_1.ml b/testsuite/tests/letrec/class_1.ml
new file mode 100644
index 0000000000..a7d0338802
--- /dev/null
+++ b/testsuite/tests/letrec/class_1.ml
@@ -0,0 +1,5 @@
+(* class expression are compiled to recursive bindings *)
+class test =
+object
+  method x = 1
+end
diff --git a/testsuite/tests/letrec/class_2.ml b/testsuite/tests/letrec/class_2.ml
new file mode 100644
index 0000000000..71c7880d67
--- /dev/null
+++ b/testsuite/tests/letrec/class_2.ml
@@ -0,0 +1,8 @@
+(* class expressions may also contain local recursive bindings *)
+class test =
+  let rec f = print_endline "f"; fun x -> g x
+      and g = print_endline "g"; fun x -> f x in
+object
+  method f : 'a 'b. 'a -> 'b = f
+  method g : 'a 'b. 'a -> 'b = g
+end
diff --git a/testsuite/tests/letrec/class_2.reference b/testsuite/tests/letrec/class_2.reference
new file mode 100644
index 0000000000..ab713757f4
--- /dev/null
+++ b/testsuite/tests/letrec/class_2.reference
@@ -0,0 +1,2 @@
+f
+g
diff --git a/testsuite/tests/letrec/evaluation_order_1.ml b/testsuite/tests/letrec/evaluation_order_1.ml
new file mode 100644
index 0000000000..5b88844d7e
--- /dev/null
+++ b/testsuite/tests/letrec/evaluation_order_1.ml
@@ -0,0 +1,20 @@
+(* test evaluation order
+
+   'y' is translated into a constant, and is therefore considered
+   non-recursive. With the current letrec compilation method,
+   it should be evaluated before x and z.
+*)
+type tree = Tree of tree list
+
+let test =
+  let rec x = (print_endline "x"; Tree [y; z])
+  and y = (print_endline "y"; Tree [])
+  and z = (print_endline "z"; Tree [x])
+  in
+  match (x, y, z) with
+    | (Tree [y1; z1], Tree[], Tree[x1]) ->
+      assert (y1 == y);
+      assert (z1 == z);
+      assert (x1 == x)
+    | _ ->
+      assert false
diff --git a/testsuite/tests/letrec/evaluation_order_1.reference b/testsuite/tests/letrec/evaluation_order_1.reference
new file mode 100644
index 0000000000..f471662b7d
--- /dev/null
+++ b/testsuite/tests/letrec/evaluation_order_1.reference
@@ -0,0 +1,3 @@
+y
+x
+z
diff --git a/testsuite/tests/letrec/evaluation_order_2.ml b/testsuite/tests/letrec/evaluation_order_2.ml
new file mode 100644
index 0000000000..736f82ad32
--- /dev/null
+++ b/testsuite/tests/letrec/evaluation_order_2.ml
@@ -0,0 +1,18 @@
+(* A variant of evaluation_order_1.ml where the side-effects
+   are inside the blocks. Note that this changes the evaluation
+   order, as y is considered recursive.
+*)
+type tree = Tree of tree list
+
+let test =
+  let rec x = (Tree [(print_endline "x"; y); z])
+  and y = Tree (print_endline "y"; [])
+  and z = Tree (print_endline "z"; [x])
+  in
+  match (x, y, z) with
+    | (Tree [y1; z1], Tree[], Tree[x1]) ->
+      assert (y1 == y);
+      assert (z1 == z);
+      assert (x1 == x)
+    | _ ->
+      assert false
diff --git a/testsuite/tests/letrec/evaluation_order_2.reference b/testsuite/tests/letrec/evaluation_order_2.reference
new file mode 100644
index 0000000000..04ec35a6dc
--- /dev/null
+++ b/testsuite/tests/letrec/evaluation_order_2.reference
@@ -0,0 +1,3 @@
+x
+y
+z
diff --git a/testsuite/tests/letrec/evaluation_order_3.ml b/testsuite/tests/letrec/evaluation_order_3.ml
new file mode 100644
index 0000000000..8f76a8f858
--- /dev/null
+++ b/testsuite/tests/letrec/evaluation_order_3.ml
@@ -0,0 +1,11 @@
+type t = { x : t; y : t }
+
+let p = print_endline
+
+let test =
+  let rec x = p "x"; { x = (p "x_x"; x); y = (p "x_y"; y) }
+      and y = p "y"; { x = (p "y_x"; x); y = (p "y_y"; y) }
+   in
+   assert (x.x == x); assert (x.y == y);
+   assert (y.x == x); assert (y.y == y);
+   ()
diff --git a/testsuite/tests/letrec/evaluation_order_3.reference b/testsuite/tests/letrec/evaluation_order_3.reference
new file mode 100644
index 0000000000..5b8c549eca
--- /dev/null
+++ b/testsuite/tests/letrec/evaluation_order_3.reference
@@ -0,0 +1,6 @@
+x
+x_y
+x_x
+y
+y_y
+y_x
diff --git a/testsuite/tests/letrec/float_block_1.ml b/testsuite/tests/letrec/float_block_1.ml
new file mode 100644
index 0000000000..cdfa9d2f85
--- /dev/null
+++ b/testsuite/tests/letrec/float_block_1.ml
@@ -0,0 +1,10 @@
+(* a bug in cmmgen.ml provokes a change in compilation order between
+   ocamlc and ocamlopt in certain letrec-bindings involving float
+   arrays *)
+let test =
+  let rec x = print_endline "x"; [| 1; 2; 3 |]
+      and y = print_endline "y"; [| 1.; 2.; 3. |]
+  in
+  assert (x = [| 1; 2; 3 |]);
+  assert (y = [| 1.; 2.; 3. |]);
+  ()
diff --git a/testsuite/tests/letrec/float_block_1.reference b/testsuite/tests/letrec/float_block_1.reference
new file mode 100644
index 0000000000..b77b4eb1d9
--- /dev/null
+++ b/testsuite/tests/letrec/float_block_1.reference
@@ -0,0 +1,2 @@
+x
+y
diff --git a/testsuite/tests/letrec/float_block_2.ml b/testsuite/tests/letrec/float_block_2.ml
new file mode 100644
index 0000000000..968cba4eb1
--- /dev/null
+++ b/testsuite/tests/letrec/float_block_2.ml
@@ -0,0 +1,7 @@
+(* a bug in cmmgen.ml provokes a segfault in certain natively compiled
+   letrec-bindings involving float arrays *)
+let test =
+  let rec x = [| y; y |] and y = 1. in
+  assert (x = [| 1.; 1. |]);
+  assert (y = 1.);
+  ()
diff --git a/testsuite/tests/letrec/lists.ml b/testsuite/tests/letrec/lists.ml
new file mode 100644
index 0000000000..5686e49357
--- /dev/null
+++ b/testsuite/tests/letrec/lists.ml
@@ -0,0 +1,8 @@
+(* a test with lists, because cyclic lists are fun *)
+let test =
+  let rec li = 0::1::2::3::4::5::6::7::8::9::li in
+  match li with
+    | 0::1::2::3::4::5::6::7::8::9::
+        0::1::2::3::4::5::6::7::8::9::li' ->
+      assert (li == li')
+    | _ -> assert false
diff --git a/testsuite/tests/letrec/mixing_value_closures_1.ml b/testsuite/tests/letrec/mixing_value_closures_1.ml
new file mode 100644
index 0000000000..e79f79ecbe
--- /dev/null
+++ b/testsuite/tests/letrec/mixing_value_closures_1.ml
@@ -0,0 +1,8 @@
+(* mixing values and closures may exercise interesting code paths *)
+type t = A of (int -> int)
+let test =
+  let rec x = A f
+  and f = function
+    | 0 -> 2
+    | n -> match x with A g -> g 0
+  in assert (f 1 = 2)
diff --git a/testsuite/tests/letrec/mixing_value_closures_2.ml b/testsuite/tests/letrec/mixing_value_closures_2.ml
new file mode 100644
index 0000000000..eb5fcb7420
--- /dev/null
+++ b/testsuite/tests/letrec/mixing_value_closures_2.ml
@@ -0,0 +1,8 @@
+(* a polymorphic variant of test3.ml; found a real bug once *)
+let test =
+  let rec x = `A f
+  and f = function
+    | 0 -> 2
+    | n -> match x with `A g -> g 0
+  in
+  assert (f 1 = 2)
diff --git a/testsuite/tests/letrec/mutual_functions.ml b/testsuite/tests/letrec/mutual_functions.ml
new file mode 100644
index 0000000000..a5b6c51ffe
--- /dev/null
+++ b/testsuite/tests/letrec/mutual_functions.ml
@@ -0,0 +1,11 @@
+(* a simple test with mutually recursive functions *)
+let test =
+  let rec even = function
+    | 0 -> true
+    | n -> odd (n - 1)
+  and odd = function
+    | 0 -> false
+    | n -> even (n - 1)
+  in
+  List.iter (fun i -> assert (even i <> odd i && even i = (i mod 2 = 0)))
+    [0;1;2;3;4;5;6]
diff --git a/testsuite/tests/lib-dynlink-bytecode/Makefile b/testsuite/tests/lib-dynlink-bytecode/Makefile
index ea07959afb..a510325bce 100644
--- a/testsuite/tests/lib-dynlink-bytecode/Makefile
+++ b/testsuite/tests/lib-dynlink-bytecode/Makefile
@@ -19,17 +19,17 @@ compile:
 run:
 	@printf " ... testing 'main'"
 	@export LD_LIBRARY_PATH=`pwd` && ./main plug1.cma plug2.cma > main.result
-	@diff -q main.reference main.result > /dev/null || (echo " => failed" && exit 1)
+	@$(DIFF) main.reference main.result > /dev/null || (echo " => failed" && exit 1)
 	@echo " => passed"
 
 	@printf " ... testing 'static'"
 	@export LD_LIBRARY_PATH=`pwd` && ./static > static.result
-	@diff -q static.reference static.result > /dev/null || (echo " => failed" && exit 1)
+	@$(DIFF) static.reference static.result > /dev/null || (echo " => failed" && exit 1)
 	@echo " => passed"
 
 	@printf " ... testing 'custom'"
 	@export LD_LIBRARY_PATH=`pwd` && ./custom > custom.result
-	@diff -q custom.reference custom.result > /dev/null || (echo " => failed" && exit 1)
+	@$(DIFF) custom.reference custom.result > /dev/null || (echo " => failed" && exit 1)
 	@echo " => passed"
 	
 promote: defaultpromote
diff --git a/testsuite/tests/lib-dynlink-csharp/Makefile b/testsuite/tests/lib-dynlink-csharp/Makefile
index 377b7d8474..06f58b72da 100644
--- a/testsuite/tests/lib-dynlink-csharp/Makefile
+++ b/testsuite/tests/lib-dynlink-csharp/Makefile
@@ -15,7 +15,7 @@ bytecode:
 	  $(OCAMLC) -output-obj -o main.dll dynlink.cma main.ml entry.c; \
 	  $(CSC) /out:main.exe main.cs; \
 	  ./main.exe > bytecode.result; \
-	  diff -q bytecode.reference bytecode.result > /dev/null && echo " => passed" || echo " => failed"; \
+	  $(DIFF) bytecode.reference bytecode.result > /dev/null && echo " => passed" || echo " => failed"; \
 	fi
 
 bytecode-dll:
@@ -27,7 +27,7 @@ bytecode-dll:
 	  $(MKDLL) -maindll -o main.dll main_obj.$(O) entry.$(O) ../../byterun/libcamlrun.$(A)  $(BYTECCLIBS) -v; \
 	  $(CSC) /out:main.exe main.cs; \
 	  ./main.exe > bytecode.result; \
-	  diff -q bytecode.reference bytecode.result > /dev/null && echo " => passed" || echo " => failed"; \
+	  $(DIFF) bytecode.reference bytecode.result > /dev/null && echo " => passed" || echo " => failed"; \
 	fi
 
 native:
@@ -38,7 +38,7 @@ native:
 	  $(OCAMLOPT) -output-obj -o main.dll dynlink.cmxa entry.c main.ml; \
 	  $(CSC) /out:main.exe main.cs; \
 	  ./main.exe > native.result; \
-	  diff -q native.reference native.result > /dev/null && echo " => passed" || echo " => failed"; \
+	  $(DIFF) native.reference native.result > /dev/null && echo " => passed" || echo " => failed"; \
 	fi
 
 native-dll:
@@ -50,7 +50,7 @@ native-dll:
 	  $(MKDLL) -maindll -o main.dll main_obj.$(O) entry.$(O) ../../asmrun/libasmrun.lib -v; \
 	  $(CSC) /out:main.exe main.cs; \
 	  ./main.exe > native.result; \
-	  diff -q native.reference native.result > /dev/null && echo " => passed" || echo " => failed"; \
+	  $(DIFF) native.reference native.result > /dev/null && echo " => passed" || echo " => failed"; \
 	fi
 
 promote: defaultpromote
diff --git a/testsuite/tests/lib-dynlink-native/Makefile b/testsuite/tests/lib-dynlink-native/Makefile
index d090d80137..d7ac244671 100644
--- a/testsuite/tests/lib-dynlink-native/Makefile
+++ b/testsuite/tests/lib-dynlink-native/Makefile
@@ -12,7 +12,7 @@ compile: $(PLUGINS) main mylib.so
 run:
 	@printf " ... testing 'main'"
 	@./main plugin_thread.so > result
-	@diff -q reference result > /dev/null || (echo " => failed" && exit 1)
+	@$(DIFF) reference result > /dev/null || (echo " => failed" && exit 1)
 	@echo " => passed"
 
 main: api.cmx main.cmx
diff --git a/testsuite/tests/lib-scanf-2/Makefile b/testsuite/tests/lib-scanf-2/Makefile
index ecb87cba20..bf7cf08af7 100644
--- a/testsuite/tests/lib-scanf-2/Makefile
+++ b/testsuite/tests/lib-scanf-2/Makefile
@@ -11,10 +11,10 @@ compile: tscanf2_io.cmo tscanf2_io.cmx
 run:
 	@printf " ... testing with ocamlc"
 	@./master.byte ./slave.byte > result.byte 2>&1
-	@diff -q reference result.byte > /dev/null || (echo " => failed" && exit 1)
+	@$(DIFF) reference result.byte > /dev/null || (echo " => failed" && exit 1)
 	@printf " ocamlopt"
 	@./master.native ./slave.native > result.native 2>&1
-	@diff -q reference result.native > /dev/null || (echo " => failed" && exit 1)
+	@$(DIFF) reference result.native > /dev/null || (echo " => failed" && exit 1)
 	@echo " => passed"
 
 promote:
diff --git a/testsuite/tests/lib-set/Makefile b/testsuite/tests/lib-set/Makefile
new file mode 100644
index 0000000000..4ba0bffc51
--- /dev/null
+++ b/testsuite/tests/lib-set/Makefile
@@ -0,0 +1,3 @@
+BASEDIR=../..
+include $(BASEDIR)/makefiles/Makefile.several
+include $(BASEDIR)/makefiles/Makefile.common
diff --git a/testsuite/tests/lib-set/testmap.ml b/testsuite/tests/lib-set/testmap.ml
new file mode 100644
index 0000000000..1197fbf6d0
--- /dev/null
+++ b/testsuite/tests/lib-set/testmap.ml
@@ -0,0 +1,123 @@
+module M = Map.Make(struct type t = int let compare = compare end)
+
+let img x m = try Some(M.find x m) with Not_found -> None
+
+let testvals = [0;1;2;3;4;5;6;7;8;9]
+
+let check msg cond =
+  if not (List.for_all cond testvals) then
+    Printf.printf "Test %s FAILED\n%!" msg
+
+let checkbool msg b =
+  if not b then
+    Printf.printf "Test %s FAILED\n%!" msg
+
+let uncurry (f: 'a -> 'b -> 'c) (x, y: 'a * 'b) : 'c = f x y
+
+let test x v s1 s2 =
+
+  checkbool "is_empty"
+    (M.is_empty s1 = List.for_all (fun i -> img i s1 = None) testvals);
+
+  check "mem"
+    (fun i -> M.mem i s1 = (img i s1 <> None));
+
+  check "add"
+    (let s = M.add x v s1 in
+     fun i -> img i s = (if i = x then Some v else img i s1));
+
+  check "singleton"
+    (let s = M.singleton x v in
+     fun i -> img i s = (if i = x then Some v else None));
+
+  check "remove"
+    (let s = M.remove x s1 in
+     fun i -> img i s = (if i = x then None else img i s1));
+
+  check "merge-union"
+    (let f _ o1 o2 =
+       match o1, o2 with
+       | Some v1, Some v2 -> Some (v1 +. v2)
+       | None, _ -> o2
+       | _, None -> o1 in
+     let s = M.merge f s1 s2 in
+     fun i -> img i s = f i (img i s1) (img i s2));
+
+  check "merge-inter"
+    (let f _ o1 o2 =
+       match o1, o2 with
+       | Some v1, Some v2 -> Some (v1 -. v2)
+       | _, _ -> None in
+     let s = M.merge f s1 s2 in
+     fun i -> img i s = f i (img i s1) (img i s2));
+
+  checkbool "bindings"
+    (let rec extract = function
+       | [] -> []
+       | hd :: tl ->
+           match img hd s1 with
+           | None -> extract tl
+           | Some v ->(hd,  v) :: extract tl in
+     M.bindings s1 = extract testvals);
+
+  checkbool "for_all"
+    (let p x y = x mod 2 = 0 in
+     M.for_all p s1 = List.for_all (uncurry p) (M.bindings s1));
+
+  checkbool "exists"
+    (let p x y = x mod 3 = 0 in
+     M.exists p s1 = List.exists (uncurry p) (M.bindings s1));
+
+  checkbool "filter"
+    (let p x y = x >= 3 && x <= 6 in
+     M.bindings(M.filter p s1) = List.filter (uncurry p) (M.bindings s1));
+
+  checkbool "partition"
+    (let p x y = x >= 3 && x <= 6 in
+     let (st,sf) = M.partition p s1
+     and (lt,lf) = List.partition (uncurry p) (M.bindings s1) in
+     M.bindings st = lt && M.bindings sf = lf);
+
+  checkbool "cardinal"
+    (M.cardinal s1 = List.length (M.bindings s1));
+
+  checkbool "min_binding"
+    (try
+       let (k,v) = M.min_binding s1 in
+       img k s1 = Some v && M.for_all (fun i _ -> k <= i) s1
+     with Not_found ->
+       M.is_empty s1);
+
+  checkbool "max_binding"
+    (try
+       let (k,v) = M.max_binding s1 in
+       img k s1 = Some v && M.for_all (fun i _ -> k >= i) s1
+     with Not_found ->
+       M.is_empty s1);
+
+  checkbool "choose"
+    (try
+       let (x,v) = M.choose s1 in img x s1 = Some v
+     with Not_found ->
+       M.is_empty s1);
+
+  check "split"
+    (let (l, p, r) = M.split x s1 in
+     fun i -> 
+       if i < x then img i l = img i s1
+       else if i > x then img i r = img i s1
+       else p = img i s1)
+
+let rkey() = Random.int 10
+
+let rdata() = Random.float 1.0
+
+let rmap() =
+  let s = ref M.empty in
+  for i = 1 to Random.int 10 do s := M.add (rkey()) (rdata()) !s done;
+  !s
+
+let _ =
+  Random.init 42;
+  for i = 1 to 25000 do test (rkey()) (rdata()) (rmap()) (rmap()) done
+  
diff --git a/testsuite/tests/lib-set/testmap.reference b/testsuite/tests/lib-set/testmap.reference
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/testsuite/tests/lib-set/testmap.reference
diff --git a/testsuite/tests/lib-set/testset.ml b/testsuite/tests/lib-set/testset.ml
new file mode 100644
index 0000000000..c4ab0441e0
--- /dev/null
+++ b/testsuite/tests/lib-set/testset.ml
@@ -0,0 +1,120 @@
+module S = Set.Make(struct type t = int let compare = compare end)
+
+let testvals = [0;1;2;3;4;5;6;7;8;9]
+
+let check msg cond =
+  if not (List.for_all cond testvals) then
+    Printf.printf "Test %s FAILED\n%!" msg
+
+let checkbool msg b =
+  if not b then
+    Printf.printf "Test %s FAILED\n%!" msg
+
+let normalize_cmp c =
+  if c = 0 then 0 else if c > 0 then 1 else -1
+
+let test x s1 s2 =
+
+  checkbool "is_empty"
+    (S.is_empty s1 = List.for_all (fun i -> not (S.mem i s1)) testvals);
+
+  check "add"
+    (let s = S.add x s1 in
+     fun i -> S.mem i s = (S.mem i s1 || i = x));
+
+  check "singleton"
+    (let s = S.singleton x in
+     fun i -> S.mem i s = (i = x));
+
+  check "remove"
+    (let s = S.remove x s1 in
+     fun i -> S.mem i s = (S.mem i s1 && i <> x));
+
+  check "union"
+    (let s = S.union s1 s2 in
+     fun i -> S.mem i s = (S.mem i s1 || S.mem i s2));
+
+  check "inter"
+    (let s = S.inter s1 s2 in
+     fun i -> S.mem i s = (S.mem i s1 && S.mem i s2));
+
+  check "diff"
+    (let s = S.diff s1 s2 in
+     fun i -> S.mem i s = (S.mem i s1 && not (S.mem i s2)));
+
+  checkbool "elements"
+    (S.elements s1 = List.filter (fun i -> S.mem i s1) testvals);
+
+  checkbool "compare"
+    (normalize_cmp (S.compare s1 s2) = normalize_cmp (compare (S.elements s1) (S.elements s2)));
+
+  checkbool "equal"
+    (S.equal s1 s2 = (S.elements s1 = S.elements s2));
+
+  check "subset"
+    (let b = S.subset s1 s2 in
+     fun i -> if b && S.mem i s1 then S.mem i s2 else true);
+
+  checkbool "subset2"
+    (let b = S.subset s1 s2 in
+     b || not (S.is_empty (S.diff s1 s2)));
+
+  checkbool "for_all"
+    (let p x = x mod 2 = 0 in
+     S.for_all p s1 = List.for_all p (S.elements s1));
+
+  checkbool "exists"
+    (let p x = x mod 3 = 0 in
+     S.exists p s1 = List.exists p (S.elements s1));
+
+  checkbool "filter"
+    (let p x = x >= 3 && x <= 6 in
+     S.elements(S.filter p s1) = List.filter p (S.elements s1));
+
+  checkbool "partition"
+    (let p x = x >= 3 && x <= 6 in
+     let (st,sf) = S.partition p s1
+     and (lt,lf) = List.partition p (S.elements s1) in
+     S.elements st = lt && S.elements sf = lf);
+
+  checkbool "cardinal"
+    (S.cardinal s1 = List.length (S.elements s1));
+
+  checkbool "min_elt"
+    (try
+       let m = S.min_elt s1 in
+       S.mem m s1 && S.for_all (fun i -> m <= i) s1
+     with Not_found ->
+       S.is_empty s1);
+
+  checkbool "max_elt"
+    (try
+       let m = S.max_elt s1 in
+       S.mem m s1 && S.for_all (fun i -> m >= i) s1
+     with Not_found ->
+       S.is_empty s1);
+
+  checkbool "choose"
+    (try
+       let x = S.choose s1 in S.mem x s1
+     with Not_found ->
+       S.is_empty s1);
+
+  check "split"
+    (let (l, p, r) = S.split x s1 in
+     fun i -> 
+       if i < x then S.mem i l = S.mem i s1
+       else if i > x then S.mem i r = S.mem i s1
+       else p = S.mem i s1)
+
+let relt() = Random.int 10
+
+let rset() =
+  let s = ref S.empty in
+  for i = 1 to Random.int 10 do s := S.add (relt()) !s done;
+  !s
+
+let _ =
+  Random.init 42;
+  for i = 1 to 25000 do test (relt()) (rset()) (rset()) done
+  
diff --git a/testsuite/tests/lib-set/testset.reference b/testsuite/tests/lib-set/testset.reference
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/testsuite/tests/lib-set/testset.reference
diff --git a/testsuite/tests/runtime-errors/Makefile b/testsuite/tests/runtime-errors/Makefile
index 63f63c9e72..1e2feb9193 100644
--- a/testsuite/tests/runtime-errors/Makefile
+++ b/testsuite/tests/runtime-errors/Makefile
@@ -16,10 +16,10 @@ run:
          for f in *.bytecode; do \
 	  printf " ... testing '$$f':"; \
 	  (./$$f > $$f.result 2>&1; true); \
-	  diff -q $$f.reference $$f.result > /dev/null || (echo " => failed" && exit 1) && echo " => passed"; \
+	  $(DIFF) $$f.reference $$f.result > /dev/null || (echo " => failed" && exit 1) && echo " => passed"; \
 	  printf " ... testing '`basename $$f bytecode`native':"; \
 	  (./`basename $$f bytecode`native > `basename $$f bytecode`native.result 2>&1; true); \
-	  diff -q `basename $$f bytecode`native.reference `basename $$f bytecode`native.result > /dev/null || (echo " => failed" && exit 1) && echo " => passed"; \
+	  $(DIFF) `basename $$f bytecode`native.reference `basename $$f bytecode`native.result > /dev/null || (echo " => failed" && exit 1) && echo " => passed"; \
 	done
 	
 promote: defaultpromote
diff --git a/testsuite/tests/tool-ocamldoc/Makefile b/testsuite/tests/tool-ocamldoc/Makefile
index 6a6b5f8907..d112f568cd 100644
--- a/testsuite/tests/tool-ocamldoc/Makefile
+++ b/testsuite/tests/tool-ocamldoc/Makefile
@@ -6,7 +6,7 @@ run: $(CUSTOM_MODULE).cmo
 	@for file in t*.ml; do \
 	  printf " ... testing '$$file'"; \
 	  $(OCAMLDOC) -hide-warnings -g $(CUSTOM_MODULE).cmo -o `basename $$file ml`result $$file; \
-	  diff -q `basename $$file ml`reference `basename $$file ml`result > /dev/null && echo " => passed" || (echo " => failed" && exit 1); \
+	  $(DIFF) `basename $$file ml`reference `basename $$file ml`result > /dev/null && echo " => passed" || (echo " => failed" && exit 1); \
 	done;
 	@$(OCAMLDOC) -hide-warnings -html t*.ml 2>&1 | grep -v test_types_display || true
 	@$(OCAMLDOC) -hide-warnings -latex t*.ml 2>&1 | grep -v test_types_display || true
diff --git a/testsuite/tests/typing-gadts/dynamic_frisch.ml.principal.reference b/testsuite/tests/typing-gadts/dynamic_frisch.ml.principal.reference
index 39102239a9..72a301c4aa 100644
--- a/testsuite/tests/typing-gadts/dynamic_frisch.ml.principal.reference
+++ b/testsuite/tests/typing-gadts/dynamic_frisch.ml.principal.reference
@@ -9,9 +9,9 @@
   | VString of string
   | VList of variant list
   | VPair of variant * variant
-val variantize : 'a ty -> 'a -> variant = <fun>
+val variantize : 't ty -> 't -> variant = <fun>
 exception VariantMismatch
-val devariantize : 'a ty -> variant -> 'a = <fun>
+val devariantize : 't ty -> variant -> 't = <fun>
 #                                                   type 'a ty =
     Int : int ty
   | String : string ty
@@ -27,7 +27,7 @@ and ('a, 'b) field = { label : string; field_type : 'b ty; get : 'a -> 'b; }
   | VList of variant list
   | VPair of variant * variant
   | VRecord of (string * variant) list
-val variantize : 'a ty -> 'a -> variant = <fun>
+val variantize : 't ty -> 't -> variant = <fun>
 #                                                                                                   type 'a ty =
     Int : int ty
   | String : string ty
@@ -48,7 +48,7 @@ and ('a, 'builder, 'b) field_ = {
   get : 'a -> 'b;
   set : 'builder -> 'b -> unit;
 }
-val devariantize : 'a ty -> variant -> 'a = <fun>
+val devariantize : 't ty -> variant -> 't = <fun>
 #                                                   type my_record = { a : int; b : string list; }
 val my_record : my_record ty =
   Record
@@ -58,7 +58,7 @@ val my_record : my_record ty =
       Field {label = "b"; field_type = List String; get = <fun>; set = <fun>}];
     create_builder = <fun>; of_builder = <fun>}
 #                                                                         type noarg = Noarg
-type ('a, 'b) ty =
+type (_, _) ty =
     Int : (int, 'c) ty
   | String : (string, 'd) ty
   | List : ('a, 'e) ty -> ('a list, 'e) ty
@@ -75,20 +75,20 @@ and ('a, 'e, 'b) ty_sum = {
   sum_inj : 'c. ('b, 'c) ty_sel * 'c -> 'a;
 }
 and 'e ty_dyn = Tdyn : ('a, 'e) ty * 'a -> 'e ty_dyn
-and ('a, 'b) ty_sel =
+and (_, _) ty_sel =
     Thd : ('a -> 'b, 'a) ty_sel
   | Ttl : ('b -> 'c, 'd) ty_sel -> ('a -> 'b -> 'c, 'd) ty_sel
-and ('a, 'b) ty_case =
+and (_, _) ty_case =
     TCarg : ('b, 'a) ty_sel * ('a, 'e) ty -> ('e, 'b) ty_case
   | TCnoarg : ('b, noarg) ty_sel -> ('e, 'b) ty_case
-#         type 'a ty_env =
+#         type _ ty_env =
     Enil : unit ty_env
   | Econs : ('a, 'e) ty * 'e ty_env -> ('a -> 'e) ty_env
-#                                                         type ('a, 'b) eq = Eq : ('a, 'a) eq
+#                                                         type (_, _) eq = Eq : ('a, 'a) eq
 val eq_sel : ('a, 'b) ty_sel -> ('a, 'c) ty_sel -> ('b, 'c) eq option = <fun>
 val get_case :
-  ('a, 'b) ty_sel ->
-  (string * ('c, 'a) ty_case) list -> string * ('b, 'c) ty option = <fun>
+  ('b, 'a) ty_sel ->
+  (string * ('e, 'b) ty_case) list -> string * ('a, 'e) ty option = <fun>
 #                                                         type variant =
     VInt of int
   | VString of string
@@ -98,8 +98,8 @@ val get_case :
   | VConv of string * variant
   | VSum of string * variant option
 val may_map : ('a -> 'b) -> 'a option -> 'b option = <fun>
-val variantize : 'a ty_env -> ('b, 'a) ty -> 'b -> variant = <fun>
-#                                               val devariantize : 'a ty_env -> ('b, 'a) ty -> variant -> 'b = <fun>
+val variantize : 'e ty_env -> ('a, 'e) ty -> 'a -> variant = <fun>
+#                                               val devariantize : 'e ty_env -> ('t, 'e) ty -> variant -> 't = <fun>
 #     val wrap_A : ('a, 'b) ty -> ([ `A of 'a ], 'b) ty = <fun>
 #   val ty : ('a, ([ `A of ('a * 'b) option ] as 'b) -> 'c) ty -> ('b, 'c) ty =
   <fun>
@@ -124,12 +124,12 @@ val v : variant =
     sum_inj = <fun>}
 #                                             val a : [ `A of int | `B of string | `C ] = `A 3
 type 'a vlist = [ `Cons of 'a * 'a vlist | `Nil ]
-val ty_list : ('a, 'b) ty -> ('a vlist, 'b) ty = <fun>
+val ty_list : ('a, 'e) ty -> ('a vlist, 'e) ty = <fun>
 val v : variant =
   VSum ("Cons",
    Some
     (VPair (VInt 1, VSum ("Cons", Some (VPair (VInt 2, VSum ("Nil", None)))))))
-#                                                               type ('a, 'b) ty =
+#                                                               type (_, _) ty =
     Int : (int, 'c) ty
   | String : (string, 'd) ty
   | List : ('a, 'e) ty -> ('a list, 'e) ty
@@ -149,7 +149,7 @@ val ty_abc : ([ `A of int | `B of string | `C ], 'e) ty = Sum (<fun>, <fun>)
 Error: This pattern matches values of type a * a vlist
        but a pattern was expected which matches values of type
          ex#46 = ex#47 * ex#48
-#                                                         type ('a, 'b) ty =
+#                                                         type (_, _) ty =
     Int : (int, 'd) ty
   | String : (string, 'f) ty
   | List : ('a, 'e) ty -> ('a list, 'e) ty
@@ -164,13 +164,13 @@ Error: This pattern matches values of type a * a vlist
         inj : 'c. ('b, 'c) ty_sel * 'c -> 'a;
         proj : 'a -> string * 'e ty_dyn option > -> ('a, 'e) ty
 and 'e ty_dyn = Tdyn : ('a, 'e) ty * 'a -> 'e ty_dyn
-and ('a, 'b) ty_sel =
+and (_, _) ty_sel =
     Thd : ('a -> 'b, 'a) ty_sel
   | Ttl : ('b -> 'c, 'd) ty_sel -> ('a -> 'b -> 'c, 'd) ty_sel
-and ('a, 'b) ty_case =
+and (_, _) ty_case =
     TCarg : ('b, 'a) ty_sel * ('a, 'e) ty -> ('e, 'b) ty_case
   | TCnoarg : ('b, noarg) ty_sel -> ('e, 'b) ty_case
 #                                                                     val ty_abc : ([ `A of int | `B of string | `C ], 'e) ty = Sum <obj>
 type 'a vlist = [ `Cons of 'a * 'a vlist | `Nil ]
-val ty_list : ('a, 'b) ty -> ('a vlist, 'b) ty = <fun>
+val ty_list : ('a, 'e) ty -> ('a vlist, 'e) ty = <fun>
 #   * * * * * * * * *   
diff --git a/testsuite/tests/typing-gadts/dynamic_frisch.ml.reference b/testsuite/tests/typing-gadts/dynamic_frisch.ml.reference
index 39102239a9..72a301c4aa 100644
--- a/testsuite/tests/typing-gadts/dynamic_frisch.ml.reference
+++ b/testsuite/tests/typing-gadts/dynamic_frisch.ml.reference
@@ -9,9 +9,9 @@
   | VString of string
   | VList of variant list
   | VPair of variant * variant
-val variantize : 'a ty -> 'a -> variant = <fun>
+val variantize : 't ty -> 't -> variant = <fun>
 exception VariantMismatch
-val devariantize : 'a ty -> variant -> 'a = <fun>
+val devariantize : 't ty -> variant -> 't = <fun>
 #                                                   type 'a ty =
     Int : int ty
   | String : string ty
@@ -27,7 +27,7 @@ and ('a, 'b) field = { label : string; field_type : 'b ty; get : 'a -> 'b; }
   | VList of variant list
   | VPair of variant * variant
   | VRecord of (string * variant) list
-val variantize : 'a ty -> 'a -> variant = <fun>
+val variantize : 't ty -> 't -> variant = <fun>
 #                                                                                                   type 'a ty =
     Int : int ty
   | String : string ty
@@ -48,7 +48,7 @@ and ('a, 'builder, 'b) field_ = {
   get : 'a -> 'b;
   set : 'builder -> 'b -> unit;
 }
-val devariantize : 'a ty -> variant -> 'a = <fun>
+val devariantize : 't ty -> variant -> 't = <fun>
 #                                                   type my_record = { a : int; b : string list; }
 val my_record : my_record ty =
   Record
@@ -58,7 +58,7 @@ val my_record : my_record ty =
       Field {label = "b"; field_type = List String; get = <fun>; set = <fun>}];
     create_builder = <fun>; of_builder = <fun>}
 #                                                                         type noarg = Noarg
-type ('a, 'b) ty =
+type (_, _) ty =
     Int : (int, 'c) ty
   | String : (string, 'd) ty
   | List : ('a, 'e) ty -> ('a list, 'e) ty
@@ -75,20 +75,20 @@ and ('a, 'e, 'b) ty_sum = {
   sum_inj : 'c. ('b, 'c) ty_sel * 'c -> 'a;
 }
 and 'e ty_dyn = Tdyn : ('a, 'e) ty * 'a -> 'e ty_dyn
-and ('a, 'b) ty_sel =
+and (_, _) ty_sel =
     Thd : ('a -> 'b, 'a) ty_sel
   | Ttl : ('b -> 'c, 'd) ty_sel -> ('a -> 'b -> 'c, 'd) ty_sel
-and ('a, 'b) ty_case =
+and (_, _) ty_case =
     TCarg : ('b, 'a) ty_sel * ('a, 'e) ty -> ('e, 'b) ty_case
   | TCnoarg : ('b, noarg) ty_sel -> ('e, 'b) ty_case
-#         type 'a ty_env =
+#         type _ ty_env =
     Enil : unit ty_env
   | Econs : ('a, 'e) ty * 'e ty_env -> ('a -> 'e) ty_env
-#                                                         type ('a, 'b) eq = Eq : ('a, 'a) eq
+#                                                         type (_, _) eq = Eq : ('a, 'a) eq
 val eq_sel : ('a, 'b) ty_sel -> ('a, 'c) ty_sel -> ('b, 'c) eq option = <fun>
 val get_case :
-  ('a, 'b) ty_sel ->
-  (string * ('c, 'a) ty_case) list -> string * ('b, 'c) ty option = <fun>
+  ('b, 'a) ty_sel ->
+  (string * ('e, 'b) ty_case) list -> string * ('a, 'e) ty option = <fun>
 #                                                         type variant =
     VInt of int
   | VString of string
@@ -98,8 +98,8 @@ val get_case :
   | VConv of string * variant
   | VSum of string * variant option
 val may_map : ('a -> 'b) -> 'a option -> 'b option = <fun>
-val variantize : 'a ty_env -> ('b, 'a) ty -> 'b -> variant = <fun>
-#                                               val devariantize : 'a ty_env -> ('b, 'a) ty -> variant -> 'b = <fun>
+val variantize : 'e ty_env -> ('a, 'e) ty -> 'a -> variant = <fun>
+#                                               val devariantize : 'e ty_env -> ('t, 'e) ty -> variant -> 't = <fun>
 #     val wrap_A : ('a, 'b) ty -> ([ `A of 'a ], 'b) ty = <fun>
 #   val ty : ('a, ([ `A of ('a * 'b) option ] as 'b) -> 'c) ty -> ('b, 'c) ty =
   <fun>
@@ -124,12 +124,12 @@ val v : variant =
     sum_inj = <fun>}
 #                                             val a : [ `A of int | `B of string | `C ] = `A 3
 type 'a vlist = [ `Cons of 'a * 'a vlist | `Nil ]
-val ty_list : ('a, 'b) ty -> ('a vlist, 'b) ty = <fun>
+val ty_list : ('a, 'e) ty -> ('a vlist, 'e) ty = <fun>
 val v : variant =
   VSum ("Cons",
    Some
     (VPair (VInt 1, VSum ("Cons", Some (VPair (VInt 2, VSum ("Nil", None)))))))
-#                                                               type ('a, 'b) ty =
+#                                                               type (_, _) ty =
     Int : (int, 'c) ty
   | String : (string, 'd) ty
   | List : ('a, 'e) ty -> ('a list, 'e) ty
@@ -149,7 +149,7 @@ val ty_abc : ([ `A of int | `B of string | `C ], 'e) ty = Sum (<fun>, <fun>)
 Error: This pattern matches values of type a * a vlist
        but a pattern was expected which matches values of type
          ex#46 = ex#47 * ex#48
-#                                                         type ('a, 'b) ty =
+#                                                         type (_, _) ty =
     Int : (int, 'd) ty
   | String : (string, 'f) ty
   | List : ('a, 'e) ty -> ('a list, 'e) ty
@@ -164,13 +164,13 @@ Error: This pattern matches values of type a * a vlist
         inj : 'c. ('b, 'c) ty_sel * 'c -> 'a;
         proj : 'a -> string * 'e ty_dyn option > -> ('a, 'e) ty
 and 'e ty_dyn = Tdyn : ('a, 'e) ty * 'a -> 'e ty_dyn
-and ('a, 'b) ty_sel =
+and (_, _) ty_sel =
     Thd : ('a -> 'b, 'a) ty_sel
   | Ttl : ('b -> 'c, 'd) ty_sel -> ('a -> 'b -> 'c, 'd) ty_sel
-and ('a, 'b) ty_case =
+and (_, _) ty_case =
     TCarg : ('b, 'a) ty_sel * ('a, 'e) ty -> ('e, 'b) ty_case
   | TCnoarg : ('b, noarg) ty_sel -> ('e, 'b) ty_case
 #                                                                     val ty_abc : ([ `A of int | `B of string | `C ], 'e) ty = Sum <obj>
 type 'a vlist = [ `Cons of 'a * 'a vlist | `Nil ]
-val ty_list : ('a, 'b) ty -> ('a vlist, 'b) ty = <fun>
+val ty_list : ('a, 'e) ty -> ('a vlist, 'e) ty = <fun>
 #   * * * * * * * * *   
diff --git a/testsuite/tests/typing-gadts/omega07.ml.principal.reference b/testsuite/tests/typing-gadts/omega07.ml.principal.reference
index 60ef06cb35..cf8b0b5bc1 100644
--- a/testsuite/tests/typing-gadts/omega07.ml.principal.reference
+++ b/testsuite/tests/typing-gadts/omega07.ml.principal.reference
@@ -1,47 +1,47 @@
 
 # * * * * *                       type ('a, 'b) sum = Inl of 'a | Inr of 'b
 type zero = Zero
-type 'a succ
-type 'a nat = NZ : zero nat | NS : 'a nat -> 'a succ nat
-#             type ('a, 'b) seq =
+type _ succ
+type _ nat = NZ : zero nat | NS : 'a nat -> 'a succ nat
+#             type (_, _) seq =
     Snil : ('a, zero) seq
   | Scons : 'a * ('a, 'n) seq -> ('a, 'n succ) seq
 #   val l1 : (int, zero succ succ) seq = Scons (3, Scons (5, Snil))
-#       *         type ('a, 'b, 'c) plus =
+#       *         type (_, _, _) plus =
     PlusZ : 'a nat -> (zero, 'a, 'a) plus
   | PlusS : ('a, 'b, 'c) plus -> ('a succ, 'b, 'c succ) plus
-#         val length : ('a, 'b) seq -> 'b nat = <fun>
-#   *                     type ('a, 'b, 'c) app =
+#         val length : ('a, 'n) seq -> 'n nat = <fun>
+#   *                     type (_, _, _) app =
     App : ('a, 'p) seq * ('n, 'm, 'p) plus -> ('a, 'n, 'm) app
-val app : ('a, 'b) seq -> ('a, 'c) seq -> ('a, 'b, 'c) app = <fun>
+val app : ('a, 'n) seq -> ('a, 'm) seq -> ('a, 'n, 'm) app = <fun>
 # *                           type tp
 type nd
-type ('a, 'b) fk
-type 'a shape =
+type (_, _) fk
+type _ shape =
     Tp : tp shape
   | Nd : nd shape
   | Fk : 'a shape * 'b shape -> ('a, 'b) fk shape
 #           type tt
 type ff
-type 'a boolean = BT : tt boolean | BF : ff boolean
-#                 type ('a, 'b) path =
+type _ boolean = BT : tt boolean | BF : ff boolean
+#                 type (_, _) path =
     Pnone : 'a -> (tp, 'a) path
   | Phere : (nd, 'a) path
   | Pleft : ('x, 'a) path -> (('x, 'y) fk, 'a) path
   | Pright : ('y, 'a) path -> (('x, 'y) fk, 'a) path
-#         type ('a, 'b) tree =
+#         type (_, _) tree =
     Ttip : (tp, 'a) tree
   | Tnode : 'a -> (nd, 'a) tree
   | Tfork : ('x, 'a) tree * ('y, 'a) tree -> (('x, 'y) fk, 'a) tree
 #   val tree1 : (((tp, nd) fk, (nd, nd) fk) fk, int) tree =
   Tfork (Tfork (Ttip, Tnode 4), Tfork (Tnode 4, Tnode 3))
-#                     val find : ('a -> 'a -> bool) -> 'a -> ('b, 'a) tree -> ('b, 'a) path list =
+#                     val find : ('a -> 'a -> bool) -> 'a -> ('sh, 'a) tree -> ('sh, 'a) path list =
   <fun>
-#             val extract : ('b, 'a) path -> ('b, 'a) tree -> 'a = <fun>
-#             type ('a, 'b) le =
+#             val extract : ('sh, 'a) path -> ('sh, 'a) tree -> 'a = <fun>
+#             type (_, _) le =
     LeZ : 'a nat -> (zero, 'a) le
   | LeS : ('n, 'm) le -> ('n succ, 'm succ) le
-#       type 'a even = EvenZ : zero even | EvenSS : 'n even -> 'n succ succ even
+#       type _ even = EvenZ : zero even | EvenSS : 'n even -> 'n succ succ even
 #         type one = zero succ
 type two = one succ
 type three = two succ
@@ -51,11 +51,11 @@ val even2 : two even = EvenSS EvenZ
 val even4 : four even = EvenSS (EvenSS EvenZ)
 #   val p1 : (two, one, three) plus = PlusS (PlusS (PlusZ (NS NZ)))
 #         val summandLessThanSum : ('a, 'b, 'c) plus -> ('a, 'c) le = <fun>
-#                                 type ('a, 'b) equal = Eq : ('a, 'a) equal
+#                                 type (_, _) equal = Eq : ('a, 'a) equal
 val convert : ('a, 'b) equal -> 'a -> 'b = <fun>
 val sameNat : 'a nat -> 'b nat -> ('a, 'b) equal option = <fun>
 #             val smaller : ('a succ, 'b succ) le -> ('a, 'b) le = <fun>
-#   type ('a, 'b) diff = Diff : 'c nat * ('a, 'c, 'b) plus -> ('a, 'b) diff
+#   type (_, _) diff = Diff : 'c nat * ('a, 'c, 'b) plus -> ('a, 'b) diff
 #   * * * * * * * * *                 val diff : ('a, 'b) le -> 'a nat -> 'b nat -> ('a, 'b) diff = <fun>
 #               Characters 87-243:
   ..match a, b,le with (* warning *)
@@ -67,38 +67,38 @@ Here is an example of a value that is not matched:
 (NS _, NZ, _)
 val diff : ('a, 'b) le -> 'a nat -> 'b nat -> ('a, 'b) diff = <fun>
 #               val diff : ('a, 'b) le -> 'b nat -> ('a, 'b) diff = <fun>
-#             type ('a, 'b) filter = Filter : ('m, 'n) le * ('a, 'm) seq -> ('a, 'n) filter
-val leS' : ('a, 'b) le -> ('a, 'b succ) le = <fun>
-#                   val filter : ('a -> bool) -> ('a, 'b) seq -> ('a, 'b) filter = <fun>
-#                             type ('a, 'b, 'c) balance =
+#             type (_, _) filter = Filter : ('m, 'n) le * ('a, 'm) seq -> ('a, 'n) filter
+val leS' : ('m, 'n) le -> ('m, 'n succ) le = <fun>
+#                   val filter : ('a -> bool) -> ('a, 'n) seq -> ('a, 'n) filter = <fun>
+#                             type (_, _, _) balance =
     Less : ('h, 'h succ, 'h succ) balance
   | Same : ('h, 'h, 'h) balance
   | More : ('h succ, 'h, 'h succ) balance
-type 'a avl =
+type _ avl =
     Leaf : zero avl
   | Node : ('hL, 'hR, 'hMax) balance * 'hL avl * int *
       'hR avl -> 'hMax succ avl
 type avl' = Avl : 'h avl -> avl'
 #                 val empty : avl' = Avl Leaf
-val elem : int -> 'a avl -> bool = <fun>
+val elem : int -> 'h avl -> bool = <fun>
 #                           val rotr :
-  'a succ succ avl ->
-  int -> 'a avl -> ('a succ succ avl, 'a succ succ succ avl) sum = <fun>
+  'n succ succ avl ->
+  int -> 'n avl -> ('n succ succ avl, 'n succ succ succ avl) sum = <fun>
 #                         val rotl :
-  'a avl ->
-  int -> 'a succ succ avl -> ('a succ succ avl, 'a succ succ succ avl) sum =
+  'n avl ->
+  int -> 'n succ succ avl -> ('n succ succ avl, 'n succ succ succ avl) sum =
   <fun>
-#                                               val ins : int -> 'a avl -> ('a avl, 'a succ avl) sum = <fun>
+#                                               val ins : int -> 'n avl -> ('n avl, 'n succ avl) sum = <fun>
 #           val insert : int -> avl' -> avl' = <fun>
-#                                                                                                                                 val del_min : 'a succ avl -> int * ('a avl, 'a succ avl) sum = <fun>
-type 'a avl_del =
+#                                                                                                                                 val del_min : 'n succ avl -> int * ('n avl, 'n succ avl) sum = <fun>
+type _ avl_del =
     Dsame : 'n avl -> 'n avl_del
   | Ddecr : ('m succ, 'n) equal * 'm avl -> 'n avl_del
-val del : int -> 'a avl -> 'a avl_del = <fun>
+val del : int -> 'n avl -> 'n avl_del = <fun>
 #           val delete : int -> avl' -> avl' = <fun>
 #                             type red
 type black
-type ('a, 'b) sub_tree =
+type (_, _) sub_tree =
     Bleaf : (black, zero) sub_tree
   | Rnode : (black, 'n) sub_tree * int *
       (black, 'n) sub_tree -> (red, 'n) sub_tree
@@ -106,16 +106,16 @@ type ('a, 'b) sub_tree =
       ('cR, 'n) sub_tree -> (black, 'n succ) sub_tree
 type rb_tree = Root : (black, 'n) sub_tree -> rb_tree
 #               type dir = LeftD | RightD
-type ('a, 'b) ctxt =
+type (_, _) ctxt =
     CNil : (black, 'n) ctxt
   | CRed : int * dir * (black, 'n) sub_tree *
       (red, 'n) ctxt -> (black, 'n) ctxt
   | CBlk : int * dir * ('c1, 'n) sub_tree *
       (black, 'n succ) ctxt -> ('c, 'n) ctxt
 #                         val blacken : (red, 'a) sub_tree -> (black, 'a succ) sub_tree = <fun>
-type 'a crep = Red : red crep | Black : black crep
-val color : ('a, 'b) sub_tree -> 'a crep = <fun>
-#                   val fill : ('a, 'b) ctxt -> ('a, 'b) sub_tree -> rb_tree = <fun>
+type _ crep = Red : red crep | Black : black crep
+val color : ('c, 'n) sub_tree -> 'c crep = <fun>
+#                   val fill : ('c, 'n) ctxt -> ('c, 'n) sub_tree -> rb_tree = <fun>
 #             val recolor :
   dir ->
   int ->
@@ -132,10 +132,10 @@ val color : ('a, 'b) sub_tree -> 'a crep = <fun>
   int ->
   (black, 'a) sub_tree -> (red, 'a) sub_tree -> (black, 'a succ) sub_tree =
   <fun>
-#                     val repair : (red, 'a) sub_tree -> ('b, 'a) ctxt -> rb_tree = <fun>
-#                     val ins : int -> ('a, 'b) sub_tree -> ('a, 'b) ctxt -> rb_tree = <fun>
+#                     val repair : (red, 'n) sub_tree -> ('c, 'n) ctxt -> rb_tree = <fun>
+#                     val ins : int -> ('c, 'n) sub_tree -> ('c, 'n) ctxt -> rb_tree = <fun>
 #   val insert : int -> rb_tree -> rb_tree = <fun>
-#                                                                                                 type 'a term =
+#                                                                                                 type _ term =
     Const : int -> int term
   | Add : (int * int -> int) term
   | LT : (int * int -> bool) term
@@ -145,16 +145,16 @@ val ex1 : int term = Ap (Add, Pair (Const 3, Const 5))
 val ex2 : (int * int) term =
   Pair (Ap (Add, Pair (Const 3, Const 5)), Const 1)
 val eval_term : 'a term -> 'a = <fun>
-type 'a rep =
+type _ rep =
     Rint : int rep
   | Rbool : bool rep
   | Rpair : 'a rep * 'b rep -> ('a * 'b) rep
   | Rfun : 'a rep * 'b rep -> ('a -> 'b) rep
-type ('a, 'b) equal = Eq : ('a, 'a) equal
+type (_, _) equal = Eq : ('a, 'a) equal
 val rep_equal : 'a rep -> 'b rep -> ('a, 'b) equal option = <fun>
 #                                                               type assoc = Assoc : string * 'a rep * 'a -> assoc
 val assoc : string -> 'a rep -> assoc list -> 'a = <fun>
-type 'a term =
+type _ term =
     Var : string * 'a rep -> 'a term
   | Abs : string * 'a rep * 'b term -> ('a -> 'b) term
   | Const : int -> int term
@@ -170,11 +170,11 @@ val ex4 : int term =
    Const 3)
 val v4 : int = 6
 #                                             type rnil
-type ('a, 'b, 'c) rcons
-type 'a is_row =
+type (_, _, _) rcons
+type _ is_row =
     Rnil : rnil is_row
   | Rcons : 'c is_row -> ('a, 'b, 'c) rcons is_row
-type ('a, 'b) lam =
+type (_, _) lam =
     Const : int -> ('e, int) lam
   | Var : 'a -> (('a, 't, 'e) rcons, 't) lam
   | Shift : ('e, 't) lam -> (('a, 'q, 'e) rcons, 't) lam
@@ -186,10 +186,10 @@ val ex1 : ((x, 'a -> 'b, (y, 'a, 'c) rcons) rcons, 'b) lam =
   App (Var X, Shift (Var Y))
 val ex2 : ('a, ('b -> 'c) -> 'b -> 'c) lam =
   Abs (<poly>, Abs (<poly>, App (Shift (Var <poly>), Var <poly>)))
-#                           type 'a env =
+#                           type _ env =
     Enil : rnil env
   | Econs : 'a * 't * 'e env -> ('a, 't, 'e) rcons env
-val eval_lam : 'a env -> ('a, 'b) lam -> 'b = <fun>
+val eval_lam : 'e env -> ('e, 't) lam -> 't = <fun>
 #                               type add = Add
 type suc = Suc
 val env0 :
@@ -233,21 +233,19 @@ val ex3 :
    App (Shift (Var Suc),
     App (Shift (Var Suc), App (Shift (Var Suc), Var Zero))))
 #     val v3 : int = 6
-#       *                                       type 'a rep = I : int rep | Ar : 'a rep * 'b rep -> ('a -> 'b) rep
+#       *                                       type _ rep = I : int rep | Ar : 'a rep * 'b rep -> ('a -> 'b) rep
 val compare : 'a rep -> 'b rep -> (string, ('a, 'b) equal) sum = <fun>
 #                     type term =
     C of int
   | Ab : string * 'a rep * term -> term
   | Ap of term * term
   | V of string
-type 'a ctx =
+type _ ctx =
     Cnil : rnil ctx
   | Ccons : 't * string * 'x rep * 'e ctx -> ('t, 'x, 'e) rcons ctx
-#                             type 'a checked =
-    Cerror of string
-  | Cok : ('e, 't) lam * 't rep -> 'e checked
-val lookup : string -> 'a ctx -> 'a checked = <fun>
-#                                                   val tc : 'a nat -> 'b ctx -> term -> 'b checked = <fun>
+#                             type _ checked = Cerror of string | Cok : ('e, 't) lam * 't rep -> 'e checked
+val lookup : string -> 'e ctx -> 'e checked = <fun>
+#                                                   val tc : 'n nat -> 'e ctx -> term -> 'e checked = <fun>
 #             val ctx0 :
   (zero, int, (suc, int -> int, (add, int -> int -> int, rnil) rcons) rcons)
   rcons ctx =
@@ -275,13 +273,13 @@ val ex1 : term = Ab ("x", I, Ap (Ap (V "+", V "x"), V "x"))
 #   val v2 : int = 6
 #                                             type pexp
 type pval
-type 'a mode = Pexp : pexp mode | Pval : pval mode
-type ('a, 'b) tarr
+type _ mode = Pexp : pexp mode | Pval : pval mode
+type (_, _) tarr
 type tint
-type ('a, 'b) rel =
+type (_, _) rel =
     IntR : (tint, int) rel
   | IntTo : ('b, 's) rel -> ((tint, 'b) tarr, int -> 's) rel
-type ('a, 'b, 'c) lam =
+type (_, _, _) lam =
     Const : ('a, 'b) rel * 'b -> (pval, 'env, 'a) lam
   | Var : 'a -> (pval, ('a, 't, 'e) rcons, 't) lam
   | Shift : ('m, 'e, 't) lam -> ('m, ('a, 'q, 'e) rcons, 't) lam
@@ -291,18 +289,18 @@ type ('a, 'b, 'c) lam =
       ('m2, 'e, 's) lam -> (pexp, 'e, 't) lam
 #                   val ex1 : (pexp, 'a, tint) lam =
   App (Lam (<poly>, Var <poly>), Const (IntR, <poly>))
-val mode : ('a, 'b, 'c) lam -> 'a mode = <fun>
-#               type ('a, 'b) sub =
+val mode : ('m, 'e, 't) lam -> 'm mode = <fun>
+#               type (_, _) sub =
     Id : ('r, 'r) sub
   | Bind : 't * ('m, 'r2, 'x) lam *
       ('r, 'r2) sub -> (('t, 'x, 'r) rcons, 'r2) sub
   | Push : ('r1, 'r2) sub -> (('a, 'b, 'r1) rcons, ('a, 'b, 'r2) rcons) sub
-type ('a, 'b) lam' = Ex : ('m, 's, 't) lam -> ('s, 't) lam'
-#                               val subst : ('a, 'b, 'c) lam -> ('b, 'd) sub -> ('d, 'c) lam' = <fun>
+type (_, _) lam' = Ex : ('m, 's, 't) lam -> ('s, 't) lam'
+#                               val subst : ('m1, 'r, 't) lam -> ('r, 's) sub -> ('s, 't) lam' = <fun>
 #       type closed = rnil
 type 'a rlam = ((pexp, closed, 'a) lam, (pval, closed, 'a) lam) sum
 #                             val rule :
   (pval, closed, ('a, 'b) tarr) lam -> (pval, closed, 'a) lam -> 'b rlam =
   <fun>
-#                                 val onestep : ('a, closed, 'b) lam -> 'b rlam = <fun>
+#                                 val onestep : ('m, closed, 't) lam -> 't rlam = <fun>
 # 
diff --git a/testsuite/tests/typing-gadts/omega07.ml.reference b/testsuite/tests/typing-gadts/omega07.ml.reference
index 60ef06cb35..cf8b0b5bc1 100644
--- a/testsuite/tests/typing-gadts/omega07.ml.reference
+++ b/testsuite/tests/typing-gadts/omega07.ml.reference
@@ -1,47 +1,47 @@
 
 # * * * * *                       type ('a, 'b) sum = Inl of 'a | Inr of 'b
 type zero = Zero
-type 'a succ
-type 'a nat = NZ : zero nat | NS : 'a nat -> 'a succ nat
-#             type ('a, 'b) seq =
+type _ succ
+type _ nat = NZ : zero nat | NS : 'a nat -> 'a succ nat
+#             type (_, _) seq =
     Snil : ('a, zero) seq
   | Scons : 'a * ('a, 'n) seq -> ('a, 'n succ) seq
 #   val l1 : (int, zero succ succ) seq = Scons (3, Scons (5, Snil))
-#       *         type ('a, 'b, 'c) plus =
+#       *         type (_, _, _) plus =
     PlusZ : 'a nat -> (zero, 'a, 'a) plus
   | PlusS : ('a, 'b, 'c) plus -> ('a succ, 'b, 'c succ) plus
-#         val length : ('a, 'b) seq -> 'b nat = <fun>
-#   *                     type ('a, 'b, 'c) app =
+#         val length : ('a, 'n) seq -> 'n nat = <fun>
+#   *                     type (_, _, _) app =
     App : ('a, 'p) seq * ('n, 'm, 'p) plus -> ('a, 'n, 'm) app
-val app : ('a, 'b) seq -> ('a, 'c) seq -> ('a, 'b, 'c) app = <fun>
+val app : ('a, 'n) seq -> ('a, 'm) seq -> ('a, 'n, 'm) app = <fun>
 # *                           type tp
 type nd
-type ('a, 'b) fk
-type 'a shape =
+type (_, _) fk
+type _ shape =
     Tp : tp shape
   | Nd : nd shape
   | Fk : 'a shape * 'b shape -> ('a, 'b) fk shape
 #           type tt
 type ff
-type 'a boolean = BT : tt boolean | BF : ff boolean
-#                 type ('a, 'b) path =
+type _ boolean = BT : tt boolean | BF : ff boolean
+#                 type (_, _) path =
     Pnone : 'a -> (tp, 'a) path
   | Phere : (nd, 'a) path
   | Pleft : ('x, 'a) path -> (('x, 'y) fk, 'a) path
   | Pright : ('y, 'a) path -> (('x, 'y) fk, 'a) path
-#         type ('a, 'b) tree =
+#         type (_, _) tree =
     Ttip : (tp, 'a) tree
   | Tnode : 'a -> (nd, 'a) tree
   | Tfork : ('x, 'a) tree * ('y, 'a) tree -> (('x, 'y) fk, 'a) tree
 #   val tree1 : (((tp, nd) fk, (nd, nd) fk) fk, int) tree =
   Tfork (Tfork (Ttip, Tnode 4), Tfork (Tnode 4, Tnode 3))
-#                     val find : ('a -> 'a -> bool) -> 'a -> ('b, 'a) tree -> ('b, 'a) path list =
+#                     val find : ('a -> 'a -> bool) -> 'a -> ('sh, 'a) tree -> ('sh, 'a) path list =
   <fun>
-#             val extract : ('b, 'a) path -> ('b, 'a) tree -> 'a = <fun>
-#             type ('a, 'b) le =
+#             val extract : ('sh, 'a) path -> ('sh, 'a) tree -> 'a = <fun>
+#             type (_, _) le =
     LeZ : 'a nat -> (zero, 'a) le
   | LeS : ('n, 'm) le -> ('n succ, 'm succ) le
-#       type 'a even = EvenZ : zero even | EvenSS : 'n even -> 'n succ succ even
+#       type _ even = EvenZ : zero even | EvenSS : 'n even -> 'n succ succ even
 #         type one = zero succ
 type two = one succ
 type three = two succ
@@ -51,11 +51,11 @@ val even2 : two even = EvenSS EvenZ
 val even4 : four even = EvenSS (EvenSS EvenZ)
 #   val p1 : (two, one, three) plus = PlusS (PlusS (PlusZ (NS NZ)))
 #         val summandLessThanSum : ('a, 'b, 'c) plus -> ('a, 'c) le = <fun>
-#                                 type ('a, 'b) equal = Eq : ('a, 'a) equal
+#                                 type (_, _) equal = Eq : ('a, 'a) equal
 val convert : ('a, 'b) equal -> 'a -> 'b = <fun>
 val sameNat : 'a nat -> 'b nat -> ('a, 'b) equal option = <fun>
 #             val smaller : ('a succ, 'b succ) le -> ('a, 'b) le = <fun>
-#   type ('a, 'b) diff = Diff : 'c nat * ('a, 'c, 'b) plus -> ('a, 'b) diff
+#   type (_, _) diff = Diff : 'c nat * ('a, 'c, 'b) plus -> ('a, 'b) diff
 #   * * * * * * * * *                 val diff : ('a, 'b) le -> 'a nat -> 'b nat -> ('a, 'b) diff = <fun>
 #               Characters 87-243:
   ..match a, b,le with (* warning *)
@@ -67,38 +67,38 @@ Here is an example of a value that is not matched:
 (NS _, NZ, _)
 val diff : ('a, 'b) le -> 'a nat -> 'b nat -> ('a, 'b) diff = <fun>
 #               val diff : ('a, 'b) le -> 'b nat -> ('a, 'b) diff = <fun>
-#             type ('a, 'b) filter = Filter : ('m, 'n) le * ('a, 'm) seq -> ('a, 'n) filter
-val leS' : ('a, 'b) le -> ('a, 'b succ) le = <fun>
-#                   val filter : ('a -> bool) -> ('a, 'b) seq -> ('a, 'b) filter = <fun>
-#                             type ('a, 'b, 'c) balance =
+#             type (_, _) filter = Filter : ('m, 'n) le * ('a, 'm) seq -> ('a, 'n) filter
+val leS' : ('m, 'n) le -> ('m, 'n succ) le = <fun>
+#                   val filter : ('a -> bool) -> ('a, 'n) seq -> ('a, 'n) filter = <fun>
+#                             type (_, _, _) balance =
     Less : ('h, 'h succ, 'h succ) balance
   | Same : ('h, 'h, 'h) balance
   | More : ('h succ, 'h, 'h succ) balance
-type 'a avl =
+type _ avl =
     Leaf : zero avl
   | Node : ('hL, 'hR, 'hMax) balance * 'hL avl * int *
       'hR avl -> 'hMax succ avl
 type avl' = Avl : 'h avl -> avl'
 #                 val empty : avl' = Avl Leaf
-val elem : int -> 'a avl -> bool = <fun>
+val elem : int -> 'h avl -> bool = <fun>
 #                           val rotr :
-  'a succ succ avl ->
-  int -> 'a avl -> ('a succ succ avl, 'a succ succ succ avl) sum = <fun>
+  'n succ succ avl ->
+  int -> 'n avl -> ('n succ succ avl, 'n succ succ succ avl) sum = <fun>
 #                         val rotl :
-  'a avl ->
-  int -> 'a succ succ avl -> ('a succ succ avl, 'a succ succ succ avl) sum =
+  'n avl ->
+  int -> 'n succ succ avl -> ('n succ succ avl, 'n succ succ succ avl) sum =
   <fun>
-#                                               val ins : int -> 'a avl -> ('a avl, 'a succ avl) sum = <fun>
+#                                               val ins : int -> 'n avl -> ('n avl, 'n succ avl) sum = <fun>
 #           val insert : int -> avl' -> avl' = <fun>
-#                                                                                                                                 val del_min : 'a succ avl -> int * ('a avl, 'a succ avl) sum = <fun>
-type 'a avl_del =
+#                                                                                                                                 val del_min : 'n succ avl -> int * ('n avl, 'n succ avl) sum = <fun>
+type _ avl_del =
     Dsame : 'n avl -> 'n avl_del
   | Ddecr : ('m succ, 'n) equal * 'm avl -> 'n avl_del
-val del : int -> 'a avl -> 'a avl_del = <fun>
+val del : int -> 'n avl -> 'n avl_del = <fun>
 #           val delete : int -> avl' -> avl' = <fun>
 #                             type red
 type black
-type ('a, 'b) sub_tree =
+type (_, _) sub_tree =
     Bleaf : (black, zero) sub_tree
   | Rnode : (black, 'n) sub_tree * int *
       (black, 'n) sub_tree -> (red, 'n) sub_tree
@@ -106,16 +106,16 @@ type ('a, 'b) sub_tree =
       ('cR, 'n) sub_tree -> (black, 'n succ) sub_tree
 type rb_tree = Root : (black, 'n) sub_tree -> rb_tree
 #               type dir = LeftD | RightD
-type ('a, 'b) ctxt =
+type (_, _) ctxt =
     CNil : (black, 'n) ctxt
   | CRed : int * dir * (black, 'n) sub_tree *
       (red, 'n) ctxt -> (black, 'n) ctxt
   | CBlk : int * dir * ('c1, 'n) sub_tree *
       (black, 'n succ) ctxt -> ('c, 'n) ctxt
 #                         val blacken : (red, 'a) sub_tree -> (black, 'a succ) sub_tree = <fun>
-type 'a crep = Red : red crep | Black : black crep
-val color : ('a, 'b) sub_tree -> 'a crep = <fun>
-#                   val fill : ('a, 'b) ctxt -> ('a, 'b) sub_tree -> rb_tree = <fun>
+type _ crep = Red : red crep | Black : black crep
+val color : ('c, 'n) sub_tree -> 'c crep = <fun>
+#                   val fill : ('c, 'n) ctxt -> ('c, 'n) sub_tree -> rb_tree = <fun>
 #             val recolor :
   dir ->
   int ->
@@ -132,10 +132,10 @@ val color : ('a, 'b) sub_tree -> 'a crep = <fun>
   int ->
   (black, 'a) sub_tree -> (red, 'a) sub_tree -> (black, 'a succ) sub_tree =
   <fun>
-#                     val repair : (red, 'a) sub_tree -> ('b, 'a) ctxt -> rb_tree = <fun>
-#                     val ins : int -> ('a, 'b) sub_tree -> ('a, 'b) ctxt -> rb_tree = <fun>
+#                     val repair : (red, 'n) sub_tree -> ('c, 'n) ctxt -> rb_tree = <fun>
+#                     val ins : int -> ('c, 'n) sub_tree -> ('c, 'n) ctxt -> rb_tree = <fun>
 #   val insert : int -> rb_tree -> rb_tree = <fun>
-#                                                                                                 type 'a term =
+#                                                                                                 type _ term =
     Const : int -> int term
   | Add : (int * int -> int) term
   | LT : (int * int -> bool) term
@@ -145,16 +145,16 @@ val ex1 : int term = Ap (Add, Pair (Const 3, Const 5))
 val ex2 : (int * int) term =
   Pair (Ap (Add, Pair (Const 3, Const 5)), Const 1)
 val eval_term : 'a term -> 'a = <fun>
-type 'a rep =
+type _ rep =
     Rint : int rep
   | Rbool : bool rep
   | Rpair : 'a rep * 'b rep -> ('a * 'b) rep
   | Rfun : 'a rep * 'b rep -> ('a -> 'b) rep
-type ('a, 'b) equal = Eq : ('a, 'a) equal
+type (_, _) equal = Eq : ('a, 'a) equal
 val rep_equal : 'a rep -> 'b rep -> ('a, 'b) equal option = <fun>
 #                                                               type assoc = Assoc : string * 'a rep * 'a -> assoc
 val assoc : string -> 'a rep -> assoc list -> 'a = <fun>
-type 'a term =
+type _ term =
     Var : string * 'a rep -> 'a term
   | Abs : string * 'a rep * 'b term -> ('a -> 'b) term
   | Const : int -> int term
@@ -170,11 +170,11 @@ val ex4 : int term =
    Const 3)
 val v4 : int = 6
 #                                             type rnil
-type ('a, 'b, 'c) rcons
-type 'a is_row =
+type (_, _, _) rcons
+type _ is_row =
     Rnil : rnil is_row
   | Rcons : 'c is_row -> ('a, 'b, 'c) rcons is_row
-type ('a, 'b) lam =
+type (_, _) lam =
     Const : int -> ('e, int) lam
   | Var : 'a -> (('a, 't, 'e) rcons, 't) lam
   | Shift : ('e, 't) lam -> (('a, 'q, 'e) rcons, 't) lam
@@ -186,10 +186,10 @@ val ex1 : ((x, 'a -> 'b, (y, 'a, 'c) rcons) rcons, 'b) lam =
   App (Var X, Shift (Var Y))
 val ex2 : ('a, ('b -> 'c) -> 'b -> 'c) lam =
   Abs (<poly>, Abs (<poly>, App (Shift (Var <poly>), Var <poly>)))
-#                           type 'a env =
+#                           type _ env =
     Enil : rnil env
   | Econs : 'a * 't * 'e env -> ('a, 't, 'e) rcons env
-val eval_lam : 'a env -> ('a, 'b) lam -> 'b = <fun>
+val eval_lam : 'e env -> ('e, 't) lam -> 't = <fun>
 #                               type add = Add
 type suc = Suc
 val env0 :
@@ -233,21 +233,19 @@ val ex3 :
    App (Shift (Var Suc),
     App (Shift (Var Suc), App (Shift (Var Suc), Var Zero))))
 #     val v3 : int = 6
-#       *                                       type 'a rep = I : int rep | Ar : 'a rep * 'b rep -> ('a -> 'b) rep
+#       *                                       type _ rep = I : int rep | Ar : 'a rep * 'b rep -> ('a -> 'b) rep
 val compare : 'a rep -> 'b rep -> (string, ('a, 'b) equal) sum = <fun>
 #                     type term =
     C of int
   | Ab : string * 'a rep * term -> term
   | Ap of term * term
   | V of string
-type 'a ctx =
+type _ ctx =
     Cnil : rnil ctx
   | Ccons : 't * string * 'x rep * 'e ctx -> ('t, 'x, 'e) rcons ctx
-#                             type 'a checked =
-    Cerror of string
-  | Cok : ('e, 't) lam * 't rep -> 'e checked
-val lookup : string -> 'a ctx -> 'a checked = <fun>
-#                                                   val tc : 'a nat -> 'b ctx -> term -> 'b checked = <fun>
+#                             type _ checked = Cerror of string | Cok : ('e, 't) lam * 't rep -> 'e checked
+val lookup : string -> 'e ctx -> 'e checked = <fun>
+#                                                   val tc : 'n nat -> 'e ctx -> term -> 'e checked = <fun>
 #             val ctx0 :
   (zero, int, (suc, int -> int, (add, int -> int -> int, rnil) rcons) rcons)
   rcons ctx =
@@ -275,13 +273,13 @@ val ex1 : term = Ab ("x", I, Ap (Ap (V "+", V "x"), V "x"))
 #   val v2 : int = 6
 #                                             type pexp
 type pval
-type 'a mode = Pexp : pexp mode | Pval : pval mode
-type ('a, 'b) tarr
+type _ mode = Pexp : pexp mode | Pval : pval mode
+type (_, _) tarr
 type tint
-type ('a, 'b) rel =
+type (_, _) rel =
     IntR : (tint, int) rel
   | IntTo : ('b, 's) rel -> ((tint, 'b) tarr, int -> 's) rel
-type ('a, 'b, 'c) lam =
+type (_, _, _) lam =
     Const : ('a, 'b) rel * 'b -> (pval, 'env, 'a) lam
   | Var : 'a -> (pval, ('a, 't, 'e) rcons, 't) lam
   | Shift : ('m, 'e, 't) lam -> ('m, ('a, 'q, 'e) rcons, 't) lam
@@ -291,18 +289,18 @@ type ('a, 'b, 'c) lam =
       ('m2, 'e, 's) lam -> (pexp, 'e, 't) lam
 #                   val ex1 : (pexp, 'a, tint) lam =
   App (Lam (<poly>, Var <poly>), Const (IntR, <poly>))
-val mode : ('a, 'b, 'c) lam -> 'a mode = <fun>
-#               type ('a, 'b) sub =
+val mode : ('m, 'e, 't) lam -> 'm mode = <fun>
+#               type (_, _) sub =
     Id : ('r, 'r) sub
   | Bind : 't * ('m, 'r2, 'x) lam *
       ('r, 'r2) sub -> (('t, 'x, 'r) rcons, 'r2) sub
   | Push : ('r1, 'r2) sub -> (('a, 'b, 'r1) rcons, ('a, 'b, 'r2) rcons) sub
-type ('a, 'b) lam' = Ex : ('m, 's, 't) lam -> ('s, 't) lam'
-#                               val subst : ('a, 'b, 'c) lam -> ('b, 'd) sub -> ('d, 'c) lam' = <fun>
+type (_, _) lam' = Ex : ('m, 's, 't) lam -> ('s, 't) lam'
+#                               val subst : ('m1, 'r, 't) lam -> ('r, 's) sub -> ('s, 't) lam' = <fun>
 #       type closed = rnil
 type 'a rlam = ((pexp, closed, 'a) lam, (pval, closed, 'a) lam) sum
 #                             val rule :
   (pval, closed, ('a, 'b) tarr) lam -> (pval, closed, 'a) lam -> 'b rlam =
   <fun>
-#                                 val onestep : ('a, closed, 'b) lam -> 'b rlam = <fun>
+#                                 val onestep : ('m, closed, 't) lam -> 't rlam = <fun>
 # 
diff --git a/testsuite/tests/typing-gadts/pr5332.ml.reference b/testsuite/tests/typing-gadts/pr5332.ml.reference
index a77459917c..4cf48a22c9 100644
--- a/testsuite/tests/typing-gadts/pr5332.ml.reference
+++ b/testsuite/tests/typing-gadts/pr5332.ml.reference
@@ -14,6 +14,6 @@
 Warning 8: this pattern-matching is not exhaustive.
 Here is an example of a value that is not matched:
 (Tbool, Tvar _)
-val f : ('a, 'b) typ -> ('a, 'b) typ -> int = <fun>
+val f : ('env, 'a) typ -> ('env, 'a) typ -> int = <fun>
 #   Exception: Match_failure ("//toplevel//", 9, 1).
 # 
diff --git a/testsuite/tests/typing-gadts/term-conv.ml.principal.reference b/testsuite/tests/typing-gadts/term-conv.ml.principal.reference
index 3c6b335f67..cff10f16f9 100644
--- a/testsuite/tests/typing-gadts/term-conv.ml.principal.reference
+++ b/testsuite/tests/typing-gadts/term-conv.ml.principal.reference
@@ -7,48 +7,48 @@
       | List : 'a ty -> 'a list ty
       | Pair : ('a ty * 'b ty) -> ('a * 'b) ty
       | Fun : ('a ty * 'b ty) -> ('a -> 'b) ty
-    type ('a, 'b) eq = Eq : ('a, 'a) eq
+    type (_, _) eq = Eq : ('a, 'a) eq
     exception CastFailure
-    val check_eq : 'a ty -> 'b ty -> ('a, 'b) eq
-    val gcast : 'a ty -> 'b ty -> 'a -> 'b
+    val check_eq : 't ty -> 't' ty -> ('t, 't') eq
+    val gcast : 't ty -> 't' ty -> 't -> 't'
   end
 #                               module HOAS :
   sig
-    type 'a term =
+    type _ term =
         Tag : 't Typeable.ty * int -> 't term
       | Con : 't -> 't term
       | Lam : 's Typeable.ty * ('s term -> 't term) -> ('s -> 't) term
       | App : ('s -> 't) term * 's term -> 't term
-    val intp : 'a term -> 'a
+    val intp : 't term -> 't
   end
 #                                                               module DeBruijn :
   sig
     type ('env, 't) ix =
         ZeroIx : ('env * 't, 't) ix
       | SuccIx : ('env, 't) ix -> ('env * 's, 't) ix
-    val to_int : ('a, 'b) ix -> int
+    val to_int : ('env, 't) ix -> int
     type ('env, 't) term =
         Var : ('env, 't) ix -> ('env, 't) term
       | Con : 't -> ('env, 't) term
       | Lam : ('env * 's, 't) term -> ('env, 's -> 't) term
       | App : ('env, 's -> 't) term * ('env, 's) term -> ('env, 't) term
-    type 'a stack =
+    type _ stack =
         Empty : unit stack
       | Push : 'env stack * 't -> ('env * 't) stack
-    val prj : ('a, 'b) ix -> 'a stack -> 'b
-    val intp : ('a, 'b) term -> 'a stack -> 'b
+    val prj : ('env, 't) ix -> 'env stack -> 't
+    val intp : ('env, 't) term -> 'env stack -> 't
   end
 #                                                                             module Convert :
   sig
-    type ('a, 'b) layout =
+    type (_, _) layout =
         EmptyLayout : ('env, unit) layout
       | PushLayout : 't Typeable.ty * ('env, 'env') layout *
           ('env, 't) DeBruijn.ix -> ('env, 'env' * 't) layout
-    val size : ('a, 'b) layout -> int
-    val inc : ('a, 'b) layout -> ('a * 't, 'b) layout
+    val size : ('env, 'env') layout -> int
+    val inc : ('env, 'env') layout -> ('env * 't, 'env') layout
     val prj :
-      'a Typeable.ty -> int -> ('b, 'c) layout -> ('b, 'a) DeBruijn.ix
-    val cvt : ('a, 'a) layout -> 'b HOAS.term -> ('a, 'b) DeBruijn.term
+      't Typeable.ty -> int -> ('env, 'env') layout -> ('env, 't) DeBruijn.ix
+    val cvt : ('env, 'env) layout -> 't HOAS.term -> ('env, 't) DeBruijn.term
     val convert : 'a HOAS.term -> (unit, 'a) DeBruijn.term
   end
 #                                               module Main :
diff --git a/testsuite/tests/typing-gadts/term-conv.ml.reference b/testsuite/tests/typing-gadts/term-conv.ml.reference
index 3c6b335f67..cff10f16f9 100644
--- a/testsuite/tests/typing-gadts/term-conv.ml.reference
+++ b/testsuite/tests/typing-gadts/term-conv.ml.reference
@@ -7,48 +7,48 @@
       | List : 'a ty -> 'a list ty
       | Pair : ('a ty * 'b ty) -> ('a * 'b) ty
       | Fun : ('a ty * 'b ty) -> ('a -> 'b) ty
-    type ('a, 'b) eq = Eq : ('a, 'a) eq
+    type (_, _) eq = Eq : ('a, 'a) eq
     exception CastFailure
-    val check_eq : 'a ty -> 'b ty -> ('a, 'b) eq
-    val gcast : 'a ty -> 'b ty -> 'a -> 'b
+    val check_eq : 't ty -> 't' ty -> ('t, 't') eq
+    val gcast : 't ty -> 't' ty -> 't -> 't'
   end
 #                               module HOAS :
   sig
-    type 'a term =
+    type _ term =
         Tag : 't Typeable.ty * int -> 't term
       | Con : 't -> 't term
       | Lam : 's Typeable.ty * ('s term -> 't term) -> ('s -> 't) term
       | App : ('s -> 't) term * 's term -> 't term
-    val intp : 'a term -> 'a
+    val intp : 't term -> 't
   end
 #                                                               module DeBruijn :
   sig
     type ('env, 't) ix =
         ZeroIx : ('env * 't, 't) ix
       | SuccIx : ('env, 't) ix -> ('env * 's, 't) ix
-    val to_int : ('a, 'b) ix -> int
+    val to_int : ('env, 't) ix -> int
     type ('env, 't) term =
         Var : ('env, 't) ix -> ('env, 't) term
       | Con : 't -> ('env, 't) term
       | Lam : ('env * 's, 't) term -> ('env, 's -> 't) term
       | App : ('env, 's -> 't) term * ('env, 's) term -> ('env, 't) term
-    type 'a stack =
+    type _ stack =
         Empty : unit stack
       | Push : 'env stack * 't -> ('env * 't) stack
-    val prj : ('a, 'b) ix -> 'a stack -> 'b
-    val intp : ('a, 'b) term -> 'a stack -> 'b
+    val prj : ('env, 't) ix -> 'env stack -> 't
+    val intp : ('env, 't) term -> 'env stack -> 't
   end
 #                                                                             module Convert :
   sig
-    type ('a, 'b) layout =
+    type (_, _) layout =
         EmptyLayout : ('env, unit) layout
       | PushLayout : 't Typeable.ty * ('env, 'env') layout *
           ('env, 't) DeBruijn.ix -> ('env, 'env' * 't) layout
-    val size : ('a, 'b) layout -> int
-    val inc : ('a, 'b) layout -> ('a * 't, 'b) layout
+    val size : ('env, 'env') layout -> int
+    val inc : ('env, 'env') layout -> ('env * 't, 'env') layout
     val prj :
-      'a Typeable.ty -> int -> ('b, 'c) layout -> ('b, 'a) DeBruijn.ix
-    val cvt : ('a, 'a) layout -> 'b HOAS.term -> ('a, 'b) DeBruijn.term
+      't Typeable.ty -> int -> ('env, 'env') layout -> ('env, 't) DeBruijn.ix
+    val cvt : ('env, 'env) layout -> 't HOAS.term -> ('env, 't) DeBruijn.term
     val convert : 'a HOAS.term -> (unit, 'a) DeBruijn.term
   end
 #                                               module Main :
diff --git a/testsuite/tests/typing-gadts/test.ml.principal.reference b/testsuite/tests/typing-gadts/test.ml.principal.reference
index 5e4458a981..f692325f1d 100644
--- a/testsuite/tests/typing-gadts/test.ml.principal.reference
+++ b/testsuite/tests/typing-gadts/test.ml.principal.reference
@@ -1,19 +1,19 @@
 
 #                                                         module Exp :
   sig
-    type 'a t =
+    type _ t =
         IntLit : int -> int t
       | BoolLit : bool -> bool t
       | Pair : 'a t * 'b t -> ('a * 'b) t
       | App : ('a -> 'b) t * 'a t -> 'b t
       | Abs : ('a -> 'b) -> ('a -> 'b) t
-    val eval : 'a t -> 'a
+    val eval : 's t -> 's
     val discern : 'a t -> int
   end
 #                                     module List :
   sig
     type zero
-    type 'a t = Nil : zero t | Cons : 'a * 'b t -> ('a * 'b) t
+    type _ t = Nil : zero t | Cons : 'a * 'b t -> ('a * 'b) t
     val head : ('a * 'b) t -> 'a
     val tail : ('a * 'b) t -> 'b t
     val length : 'a t -> int
@@ -35,17 +35,17 @@ module Nonexhaustive :
   sig
     type 'a u = C1 : int -> int u | C2 : bool -> bool u
     type 'a v = C1 : int -> int v
-    val unexhaustive : 'a u -> 'a
+    val unexhaustive : 's u -> 's
     module M : sig type t type u end
     type 'a t = Foo : M.t -> M.t t | Bar : M.u -> M.u t
-    val same_type : 'a t * 'a t -> bool
+    val same_type : 's t * 's t -> bool
   end
 #                             module Exhaustive :
   sig
     type t = int
     type u = bool
     type 'a v = Foo : t -> t v | Bar : u -> u v
-    val same_type : 'a v * 'a v -> bool
+    val same_type : 's v * 's v -> bool
   end
 #               Characters 119-120:
       let eval (D x) = x
@@ -76,7 +76,7 @@ Error: This expression has type bool but an expression was expected of type s
                               ^
 Error: This pattern matches values of type b
        but a pattern was expected which matches values of type a
-#   type 'a t = Int : int t
+#   type _ t = Int : int t
 #   val ky : 'a -> 'a -> 'a = <fun>
 #       val test : 'a t -> 'a = <fun>
 #       val test : 'a t -> int = <fun>
@@ -138,11 +138,11 @@ Error: This expression has type a = int
        This instance of int is ambiguous:
        it would escape the scope of its equation
 #           val f : 'a t -> int -> int = <fun>
-#                     type 'a h = Has_m : < m : int > h | Has_b : < b : bool > h
+#                     type _ h = Has_m : < m : int > h | Has_b : < b : bool > h
 val f : 'a h -> 'a = <fun>
-#               type 'a j = Has_A : [ `A of int ] j | Has_B : [ `B of bool ] j
+#               type _ j = Has_A : [ `A of int ] j | Has_B : [ `B of bool ] j
 val f : 'a j -> 'a = <fun>
-#   type ('a, 'b) eq = Eq : ('a, 'a) eq
+#   type (_, _) eq = Eq : ('a, 'a) eq
 #       Characters 5-91:
   ....f : type a b. (a,b) eq -> (<m : a; ..> as 'a) -> (<m : b; ..> as 'a) =
     fun Eq o -> o
@@ -205,8 +205,8 @@ Error: This expression has type [> `A of a ]
   ....f : type a b. (a,b) eq -> [< `A of a | `B] -> [< `A of b | `B] =
     fun Eq o -> o..............
 Error: This definition has type
-         ('c, 'd) eq -> ([< `A of 'd & 'c | `B ] as 'e) -> 'e
-       which is less general than 'a 'b. ('a, 'b) eq -> 'e -> 'e
+         ('a, 'b) eq -> ([< `A of 'b & 'a | `B ] as 'c) -> 'c
+       which is less general than 'a0 'b0. ('a0, 'b0) eq -> 'c -> 'c
 #     val f : ('a, 'b) eq -> [ `A of 'a | `B ] -> [ `A of 'b | `B ] = <fun>
 #       val f : ('a, int) eq -> [ `A of 'a ] -> bool = <fun>
 #           Characters 166-167:
@@ -226,7 +226,7 @@ Error: This expression has type [> `A of a | `B ]
        This instance of a is ambiguous:
        it would escape the scope of its equation
 #                                                     type 'a t = A of int | B of bool | C of float | D of 'a
-type 'a ty =
+type _ ty =
     TE : 'a ty -> 'a array ty
   | TA : int ty
   | TB : bool ty
@@ -276,11 +276,11 @@ Error: This expression has type (a, a) eq
        but an expression was expected of type (a, b) eq
 #       val f : ('a M.t * 'a, 'b M.t * 'b) eq -> ('a, 'b) eq = <fun>
 #       val f : ('a * 'a M.t, 'b * 'b M.t) eq -> ('a, 'b) eq = <fun>
-#                     type 'a t = V1 : [ `A | `B ] t | V2 : [ `C | `D ] t
+#                     type _ t = V1 : [ `A | `B ] t | V2 : [ `C | `D ] t
 val f : 'a t -> 'a = <fun>
 #   - : [ `A | `B ] = `A
-#                 type 'a int_foo = IF_constr : < foo : int; .. > int_foo
-type 'a int_bar = IB_constr : < bar : int; .. > int_bar
+#                 type _ int_foo = IF_constr : < foo : int; .. > int_foo
+type _ int_bar = IB_constr : < bar : int; .. > int_bar
 #         Characters 98-99:
     (x:<foo:int>)
      ^
diff --git a/testsuite/tests/typing-gadts/test.ml.reference b/testsuite/tests/typing-gadts/test.ml.reference
index 3b62fdef83..8d05b4ffe8 100644
--- a/testsuite/tests/typing-gadts/test.ml.reference
+++ b/testsuite/tests/typing-gadts/test.ml.reference
@@ -1,19 +1,19 @@
 
 #                                                         module Exp :
   sig
-    type 'a t =
+    type _ t =
         IntLit : int -> int t
       | BoolLit : bool -> bool t
       | Pair : 'a t * 'b t -> ('a * 'b) t
       | App : ('a -> 'b) t * 'a t -> 'b t
       | Abs : ('a -> 'b) -> ('a -> 'b) t
-    val eval : 'a t -> 'a
+    val eval : 's t -> 's
     val discern : 'a t -> int
   end
 #                                     module List :
   sig
     type zero
-    type 'a t = Nil : zero t | Cons : 'a * 'b t -> ('a * 'b) t
+    type _ t = Nil : zero t | Cons : 'a * 'b t -> ('a * 'b) t
     val head : ('a * 'b) t -> 'a
     val tail : ('a * 'b) t -> 'b t
     val length : 'a t -> int
@@ -35,17 +35,17 @@ module Nonexhaustive :
   sig
     type 'a u = C1 : int -> int u | C2 : bool -> bool u
     type 'a v = C1 : int -> int v
-    val unexhaustive : 'a u -> 'a
+    val unexhaustive : 's u -> 's
     module M : sig type t type u end
     type 'a t = Foo : M.t -> M.t t | Bar : M.u -> M.u t
-    val same_type : 'a t * 'a t -> bool
+    val same_type : 's t * 's t -> bool
   end
 #                             module Exhaustive :
   sig
     type t = int
     type u = bool
     type 'a v = Foo : t -> t v | Bar : u -> u v
-    val same_type : 'a v * 'a v -> bool
+    val same_type : 's v * 's v -> bool
   end
 #               Characters 119-120:
       let eval (D x) = x
@@ -69,15 +69,15 @@ Error: This pattern matches values of type ([? `A ] as 'a) * bool t
        but a pattern was expected which matches values of type 'a * int t
 #                                 module Propagation :
   sig
-    type 'a t = IntLit : int -> int t | BoolLit : bool -> bool t
-    val check : 'a t -> 'a
+    type _ t = IntLit : int -> int t | BoolLit : bool -> bool t
+    val check : 's t -> 's
   end
 #             Characters 87-88:
     let f = function A -> 1 | B -> 2
                               ^
 Error: This pattern matches values of type b
        but a pattern was expected which matches values of type a
-#   type 'a t = Int : int t
+#   type _ t = Int : int t
 #   val ky : 'a -> 'a -> 'a = <fun>
 #       val test : 'a t -> 'a = <fun>
 #       val test : 'a t -> int = <fun>
@@ -139,11 +139,11 @@ Error: This expression has type a = int
        This instance of int is ambiguous:
        it would escape the scope of its equation
 #           val f : 'a t -> int -> int = <fun>
-#                     type 'a h = Has_m : < m : int > h | Has_b : < b : bool > h
+#                     type _ h = Has_m : < m : int > h | Has_b : < b : bool > h
 val f : 'a h -> 'a = <fun>
-#               type 'a j = Has_A : [ `A of int ] j | Has_B : [ `B of bool ] j
+#               type _ j = Has_A : [ `A of int ] j | Has_B : [ `B of bool ] j
 val f : 'a j -> 'a = <fun>
-#   type ('a, 'b) eq = Eq : ('a, 'a) eq
+#   type (_, _) eq = Eq : ('a, 'a) eq
 #       Characters 5-91:
   ....f : type a b. (a,b) eq -> (<m : a; ..> as 'a) -> (<m : b; ..> as 'a) =
     fun Eq o -> o
@@ -199,8 +199,8 @@ Error: This expression has type [> `A of a ]
   ....f : type a b. (a,b) eq -> [< `A of a | `B] -> [< `A of b | `B] =
     fun Eq o -> o..............
 Error: This definition has type
-         ('c, 'd) eq -> ([< `A of 'd & 'c | `B ] as 'e) -> 'e
-       which is less general than 'a 'b. ('a, 'b) eq -> 'e -> 'e
+         ('a, 'b) eq -> ([< `A of 'b & 'a | `B ] as 'c) -> 'c
+       which is less general than 'a0 'b0. ('a0, 'b0) eq -> 'c -> 'c
 #     val f : ('a, 'b) eq -> [ `A of 'a | `B ] -> [ `A of 'b | `B ] = <fun>
 #       val f : ('a, int) eq -> [ `A of 'a ] -> bool = <fun>
 #           val f : ('a, 'b) eq -> [ `A of 'a | `B ] -> [ `A of 'b | `B ] = <fun>
@@ -213,7 +213,7 @@ Error: This expression has type [> `A of a | `B ]
        This instance of a is ambiguous:
        it would escape the scope of its equation
 #                                                     type 'a t = A of int | B of bool | C of float | D of 'a
-type 'a ty =
+type _ ty =
     TE : 'a ty -> 'a array ty
   | TA : int ty
   | TB : bool ty
@@ -263,11 +263,11 @@ Error: This expression has type (a, a) eq
        but an expression was expected of type (a, b) eq
 #       val f : ('a M.t * 'a, 'b M.t * 'b) eq -> ('a, 'b) eq = <fun>
 #       val f : ('a * 'a M.t, 'b * 'b M.t) eq -> ('a, 'b) eq = <fun>
-#                     type 'a t = V1 : [ `A | `B ] t | V2 : [ `C | `D ] t
+#                     type _ t = V1 : [ `A | `B ] t | V2 : [ `C | `D ] t
 val f : 'a t -> 'a = <fun>
 #   - : [ `A | `B ] = `A
-#                 type 'a int_foo = IF_constr : < foo : int; .. > int_foo
-type 'a int_bar = IB_constr : < bar : int; .. > int_bar
+#                 type _ int_foo = IF_constr : < foo : int; .. > int_foo
+type _ int_bar = IB_constr : < bar : int; .. > int_bar
 #         Characters 98-99:
     (x:<foo:int>)
      ^
diff --git a/testsuite/tests/typing-gadts/yallop_bugs.ml.principal.reference b/testsuite/tests/typing-gadts/yallop_bugs.ml.principal.reference
index 5b1016c97c..ddae4d248e 100644
--- a/testsuite/tests/typing-gadts/yallop_bugs.ml.principal.reference
+++ b/testsuite/tests/typing-gadts/yallop_bugs.ml.principal.reference
@@ -15,8 +15,8 @@ Error: In this GADT definition, the variance of some parameter
 Warning 8: this pattern-matching is not exhaustive.
 Here is an example of a value that is not matched:
 (IntLit, 0)
-type 'a t = IntLit : int t | BoolLit : bool t
-val check : 'a t * 'a -> bool = <fun>
+type _ t = IntLit : int t | BoolLit : bool t
+val check : 's t * 's -> bool = <fun>
 #             Characters 91-180:
   .............................................function
     | {fst = BoolLit; snd = false} -> false
@@ -25,5 +25,5 @@ Warning 8: this pattern-matching is not exhaustive.
 Here is an example of a value that is not matched:
 {fst=IntLit; snd=0}
 type ('a, 'b) pair = { fst : 'a; snd : 'b; }
-val check : ('a t, 'a) pair -> bool = <fun>
+val check : ('s t, 's) pair -> bool = <fun>
 # 
diff --git a/testsuite/tests/typing-gadts/yallop_bugs.ml.reference b/testsuite/tests/typing-gadts/yallop_bugs.ml.reference
index 5b1016c97c..ddae4d248e 100644
--- a/testsuite/tests/typing-gadts/yallop_bugs.ml.reference
+++ b/testsuite/tests/typing-gadts/yallop_bugs.ml.reference
@@ -15,8 +15,8 @@ Error: In this GADT definition, the variance of some parameter
 Warning 8: this pattern-matching is not exhaustive.
 Here is an example of a value that is not matched:
 (IntLit, 0)
-type 'a t = IntLit : int t | BoolLit : bool t
-val check : 'a t * 'a -> bool = <fun>
+type _ t = IntLit : int t | BoolLit : bool t
+val check : 's t * 's -> bool = <fun>
 #             Characters 91-180:
   .............................................function
     | {fst = BoolLit; snd = false} -> false
@@ -25,5 +25,5 @@ Warning 8: this pattern-matching is not exhaustive.
 Here is an example of a value that is not matched:
 {fst=IntLit; snd=0}
 type ('a, 'b) pair = { fst : 'a; snd : 'b; }
-val check : ('a t, 'a) pair -> bool = <fun>
+val check : ('s t, 's) pair -> bool = <fun>
 # 
diff --git a/testsuite/tests/typing-objects/Tests.ml b/testsuite/tests/typing-objects/Tests.ml
index 19d20d8821..c7a5cb3d16 100644
--- a/testsuite/tests/typing-objects/Tests.ml
+++ b/testsuite/tests/typing-objects/Tests.ml
@@ -302,3 +302,26 @@ end;;
 let x = new d () in x#n, x#o;;
 
 class c () = object method virtual m : int method private m = 1 end;;
+
+(* Marshaling (cf. PR#5436) *)
+
+Oo.id (object end);;
+Oo.id (object end);;
+Oo.id (object end);;
+let o = object end in
+  let s = Marshal.to_string o [] in
+  let o' : < > = Marshal.from_string s 0 in
+  let o'' : < > = Marshal.from_string s 0 in
+  (Oo.id o, Oo.id o', Oo.id o'');;
+
+let o = object val x = 33 method m = x end in
+  let s = Marshal.to_string o [Marshal.Closures] in
+  let o' : <m:int> = Marshal.from_string s 0 in
+  let o'' : <m:int> = Marshal.from_string s 0 in
+  (Oo.id o, Oo.id o', Oo.id o'', o#m, o'#m);;
+
+let o = object val x = 33 val y = 44 method m = x end in
+  let s = Marshal.to_string o [Marshal.Closures] in
+  let o' : <m:int> = Marshal.from_string s 0 in
+  let o'' : <m:int> = Marshal.from_string s 0 in
+  (Oo.id o, Oo.id o', Oo.id o'', o#m, o'#m);;
diff --git a/testsuite/tests/typing-objects/Tests.ml.reference b/testsuite/tests/typing-objects/Tests.ml.reference
index a78367fdfe..4df2316922 100644
--- a/testsuite/tests/typing-objects/Tests.ml.reference
+++ b/testsuite/tests/typing-objects/Tests.ml.reference
@@ -292,4 +292,10 @@ Warning 10: this expression should have type unit.
   unit -> object method private m : int method n : int method o : int end
 #   - : int * int = (1, 1)
 #   class c : unit -> object method m : int end
+#       - : int = 15
+# - : int = 16
+# - : int = 17
+#         - : int * int * int = (18, 19, 20)
+#           - : int * int * int * int * int = (21, 22, 23, 33, 33)
+#           - : int * int * int * int * int = (24, 25, 26, 33, 33)
 # 
diff --git a/testsuite/tests/typing-poly/poly.ml.principal.reference b/testsuite/tests/typing-poly/poly.ml.principal.reference
index 65043c786e..b953491622 100644
--- a/testsuite/tests/typing-poly/poly.ml.principal.reference
+++ b/testsuite/tests/typing-poly/poly.ml.principal.reference
@@ -576,8 +576,8 @@ val g : 'a -> int = <fun>
 #     Characters 34-74:
     function Leaf _ -> 1 | Node x -> 1 + d x
     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Error: This definition has type 'b t -> int which is less general than
-         'a. 'a t -> int
+Error: This definition has type 'a t -> int which is less general than
+         'a0. 'a0 t -> int
 #   Characters 34-78:
     function Leaf x -> x | Node x -> 1 + depth x;; (* fails *)
     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
@@ -586,12 +586,12 @@ Error: This definition has type int t -> int which is less general than
 #   Characters 34-74:
     function Leaf x -> x | Node x -> depth x;; (* fails *)
     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Error: This definition has type 'b t -> 'b which is less general than
-         'a. 'a t -> 'b
+Error: This definition has type 'a t -> 'a which is less general than
+         'a0. 'a0 t -> 'a
 #   Characters 38-78:
     function Leaf x -> x | Node x -> depth x;; (* fails *)
     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Error: This definition has type 'c. 'c t -> 'c which is less general than
+Error: This definition has type 'b. 'b t -> 'b which is less general than
          'b 'a. 'a t -> 'b
 #   val r : 'a list * '_b list ref = ([], {contents = []})
 val q : unit -> 'a list * '_b list ref = <fun>
diff --git a/testsuite/tests/typing-poly/poly.ml.reference b/testsuite/tests/typing-poly/poly.ml.reference
index 37601416bb..71befc5820 100644
--- a/testsuite/tests/typing-poly/poly.ml.reference
+++ b/testsuite/tests/typing-poly/poly.ml.reference
@@ -539,8 +539,8 @@ val g : 'a -> int = <fun>
 #     Characters 34-74:
     function Leaf _ -> 1 | Node x -> 1 + d x
     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Error: This definition has type 'b t -> int which is less general than
-         'a. 'a t -> int
+Error: This definition has type 'a t -> int which is less general than
+         'a0. 'a0 t -> int
 #   Characters 34-78:
     function Leaf x -> x | Node x -> 1 + depth x;; (* fails *)
     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
@@ -549,12 +549,12 @@ Error: This definition has type int t -> int which is less general than
 #   Characters 34-74:
     function Leaf x -> x | Node x -> depth x;; (* fails *)
     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Error: This definition has type 'b t -> 'b which is less general than
-         'a. 'a t -> 'b
+Error: This definition has type 'a t -> 'a which is less general than
+         'a0. 'a0 t -> 'a
 #   Characters 38-78:
     function Leaf x -> x | Node x -> depth x;; (* fails *)
     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Error: This definition has type 'c. 'c t -> 'c which is less general than
+Error: This definition has type 'b. 'b t -> 'b which is less general than
          'b 'a. 'a t -> 'b
 #   val r : 'a list * '_b list ref = ([], {contents = []})
 val q : unit -> 'a list * '_b list ref = <fun>
diff --git a/testsuite/tests/typing-private-bugs/pr5469_ok.ml b/testsuite/tests/typing-private-bugs/pr5469_ok.ml
new file mode 100644
index 0000000000..74d355499c
--- /dev/null
+++ b/testsuite/tests/typing-private-bugs/pr5469_ok.ml
@@ -0,0 +1,7 @@
+module M (T:sig type t end)
+ = struct type t = private { t : T.t } end
+module P
+ = struct
+       module T = struct type t end
+       module R = M(T)
+ end
diff --git a/testsuite/tests/warnings/Makefile b/testsuite/tests/warnings/Makefile
index eca0a1ee7b..12d375e4a7 100644
--- a/testsuite/tests/warnings/Makefile
+++ b/testsuite/tests/warnings/Makefile
@@ -6,7 +6,7 @@ run-all:
 	@for file in *.ml; do \
 	  printf " ... testing '$$file':"; \
 	  $(OCAMLC) $(FLAGS) -o $(EXECNAME) $$file 2> `basename $$file ml`result; \
-	  diff -q `basename $$file ml`reference `basename $$file ml`result > /dev/null && echo " => passed" || echo " => failed"; \
+	  $(DIFF) `basename $$file ml`reference `basename $$file ml`result > /dev/null && echo " => passed" || echo " => failed"; \
 	done;
 
 promote: defaultpromote
diff --git a/tools/addlabels.ml b/tools/addlabels.ml
index db8ecdc9a9..c057e72ca8 100644
--- a/tools/addlabels.ml
+++ b/tools/addlabels.ml
@@ -324,7 +324,6 @@ let rec add_labels_class ~text ~classes ~values ~methods cl =
               add_labels_expr ~text ~classes ~values e;
               values
           | Pcf_inher _ | Pcf_valvirt _ | Pcf_virt _ | Pcf_cstr _ -> values
-          | Pcf_let _ -> values (* not in the grammar *)
         end)
   | Pcl_fun (_, opt, pat, cl) ->
       begin match opt with None -> ()
diff --git a/tools/depend.ml b/tools/depend.ml
index 24ccad116a..948646a823 100644
--- a/tools/depend.ml
+++ b/tools/depend.ml
@@ -299,7 +299,6 @@ and add_class_field bv = function
   | Pcf_virt(_, _, ty, _) -> add_type bv ty
   | Pcf_meth(_, _, _, e, _) -> add_expr bv e
   | Pcf_cstr(ty1, ty2, _) -> add_type bv ty1; add_type bv ty2
-  | Pcf_let(_, pel, _) -> add_pat_expr_list bv pel
   | Pcf_init e -> add_expr bv e
 
 and add_class_declaration bv decl =
diff --git a/tools/ocamlprof.ml b/tools/ocamlprof.ml
index c1ed927e46..b8a6b3fa40 100644
--- a/tools/ocamlprof.ml
+++ b/tools/ocamlprof.ml
@@ -328,8 +328,6 @@ and rewrite_class_field iflag =
   | Pcf_meth (_, _, _, sexp, loc) ->
       if !instr_fun && not loc.loc_ghost then insert_profile rw_exp sexp
       else rewrite_exp iflag sexp
-  | Pcf_let(_, spat_sexp_list, _) ->
-      rewrite_patexp_list iflag spat_sexp_list
   | Pcf_init sexp ->
       rewrite_exp iflag sexp
   | Pcf_valvirt _ | Pcf_virt _ | Pcf_cstr _  -> ()
diff --git a/toplevel/opttoploop.ml b/toplevel/opttoploop.ml
index a34e231aaf..1fa5a3fd08 100644
--- a/toplevel/opttoploop.ml
+++ b/toplevel/opttoploop.ml
@@ -300,8 +300,15 @@ let use_print_results = ref true
 
 let use_file ppf name =
   try
-    let filename = find_in_path !Config.load_path name in
-    let ic = open_in_bin filename in
+    let (filename, ic, must_close) =
+      if name = "" then
+        ("(stdin)", stdin, false)
+      else begin
+        let filename = find_in_path !Config.load_path name in
+        let ic = open_in_bin filename in
+        (filename, ic, true)
+      end
+    in
     let lb = Lexing.from_channel ic in
     Location.init lb filename;
     (* Skip initial #! line if any *)
@@ -319,7 +326,7 @@ let use_file ppf name =
         | Exit -> false
         | Sys.Break -> fprintf ppf "Interrupted.@."; false
         | x -> Opterrors.report_error ppf x; false) in
-    close_in ic;
+    if must_close then close_in ic;
     success
   with Not_found -> fprintf ppf "Cannot find file %s.@." name; false
 
diff --git a/toplevel/opttopmain.ml b/toplevel/opttopmain.ml
index dd4a52b473..e13bfca4ed 100644
--- a/toplevel/opttopmain.ml
+++ b/toplevel/opttopmain.ml
@@ -79,6 +79,7 @@ module Options = Main_args.Make_opttop_options (struct
   let _rectypes = set recursive_types
   let _strict_sequence = set strict_sequence
   let _S = set keep_asm_file
+  let _stdin () = file_argument ""
   let _unsafe = set fast
   let _version () = print_version ()
   let _vnum () = print_version_num ()
diff --git a/toplevel/toploop.ml b/toplevel/toploop.ml
index 28894d2557..3d2f72f201 100644
--- a/toplevel/toploop.ml
+++ b/toplevel/toploop.ml
@@ -283,14 +283,21 @@ let protect r newval body =
     r := oldval;
     raise x
 
-(* Read and execute commands from a file *)
+(* Read and execute commands from a file, or from stdin if [name] is "". *)
 
 let use_print_results = ref true
 
 let use_file ppf name =
   try
-    let filename = find_in_path !Config.load_path name in
-    let ic = open_in_bin filename in
+    let (filename, ic, must_close) =
+      if name = "" then
+        ("(stdin)", stdin, false)
+      else begin
+        let filename = find_in_path !Config.load_path name in
+        let ic = open_in_bin filename in
+        (filename, ic, true)
+      end
+    in
     let lb = Lexing.from_channel ic in
     Location.init lb filename;
     (* Skip initial #! line if any *)
@@ -308,7 +315,7 @@ let use_file ppf name =
         | Exit -> false
         | Sys.Break -> fprintf ppf "Interrupted.@."; false
         | x -> Errors.report_error ppf x; false) in
-    close_in ic;
+    if must_close then close_in ic;
     success
   with Not_found -> fprintf ppf "Cannot find file %s.@." name; false
 
@@ -423,7 +430,7 @@ let loop ppf =
     | x -> Errors.report_error ppf x; Btype.backtrack snap
   done
 
-(* Execute a script *)
+(* Execute a script.  If [name] is "", read the script from stdin. *)
 
 let run_script ppf name args =
   let len = Array.length args in
diff --git a/toplevel/topmain.ml b/toplevel/topmain.ml
index a3dc5a458a..d6053e381a 100644
--- a/toplevel/topmain.ml
+++ b/toplevel/topmain.ml
@@ -14,7 +14,8 @@
 
 open Clflags
 
-let usage = "Usage: ocaml <options> <object-files> [script-file]\noptions are:"
+let usage = "Usage: ocaml <options> <object-files> [script-file [arguments]]\n\
+             options are:"
 
 let preload_objects = ref []
 
@@ -31,6 +32,7 @@ let prepare ppf =
       Format.fprintf ppf "Uncaught exception: %s\n" (Printexc.to_string x);
       false
 
+(* If [name] is "", then the "file" is stdin treated as a script file. *)
 let file_argument name =
   let ppf = Format.err_formatter in
   if Filename.check_suffix name ".cmo" || Filename.check_suffix name ".cma"
@@ -72,6 +74,7 @@ module Options = Main_args.Make_bytetop_options (struct
   let _nostdlib = set no_std_include
   let _principal = set principal
   let _rectypes = set recursive_types
+  let _stdin () = file_argument ""
   let _strict_sequence = set strict_sequence
   let _unsafe = set fast
   let _version () = print_version ()
diff --git a/typing/ctype.ml b/typing/ctype.ml
index 5e27441eaa..cbd9ec1440 100644
--- a/typing/ctype.ml
+++ b/typing/ctype.ml
@@ -1176,9 +1176,15 @@ let rec copy_sep fixed free bound visited ty =
     t
   end
 
-let instance_poly fixed univars sch =
-  let vars = List.map (fun _ -> newvar ()) univars in
-  let pairs = List.map2 (fun u v -> repr u, (v, [])) univars vars in
+let instance_poly ?(keep_names=false) fixed univars sch =
+  let univars = List.map repr univars in
+  let copy_var ty =
+    match ty.desc with
+      Tunivar name -> if keep_names then newty (Tvar name) else newvar ()
+    | _ -> assert false
+  in
+  let vars = List.map copy_var univars in
+  let pairs = List.map2 (fun u v -> u, (v, [])) univars vars in
   delayed_copy := [];
   let ty = copy_sep fixed (compute_univars sch) [] pairs sch in
   List.iter Lazy.force !delayed_copy;
diff --git a/typing/ctype.mli b/typing/ctype.mli
index 0c42edafdf..c4d4ff13a3 100644
--- a/typing/ctype.mli
+++ b/typing/ctype.mli
@@ -128,6 +128,7 @@ val instance_declaration: type_declaration -> type_declaration
 val instance_class:
         type_expr list -> class_type -> type_expr list * class_type
 val instance_poly:
+        ?keep_names:bool ->
         bool -> type_expr list -> type_expr -> type_expr list * type_expr
         (* Take an instance of a type scheme containing free univars *)
 val instance_label:
diff --git a/typing/mtype.ml b/typing/mtype.ml
index 404dda95bc..57ed4e2901 100644
--- a/typing/mtype.ml
+++ b/typing/mtype.ml
@@ -48,8 +48,9 @@ and strengthen_sig env sg p =
       sigelt :: strengthen_sig env rem p
   | Tsig_type(id, decl, rs) :: rem ->
       let newdecl =
-        match decl.type_manifest with
-          Some ty when decl.type_private = Public -> decl
+        match decl.type_manifest, decl.type_private, decl.type_kind with
+          Some _, Public, _ -> decl
+        | Some _, Private, (Type_record _ | Type_variant _) -> decl
         | _ ->
             let manif =
               Some(Btype.newgenty(Tconstr(Pdot(p, Ident.name id, nopos),
diff --git a/typing/oprint.ml b/typing/oprint.ml
index 21ef160806..0bfd8797cd 100644
--- a/typing/oprint.ml
+++ b/typing/oprint.ml
@@ -265,9 +265,9 @@ let out_type = ref print_out_type
 (* Class types *)
 
 let type_parameter ppf (ty, (co, cn)) =
-  fprintf ppf "%s'%s" (if not cn then "+" else if not co then "-" else "")
-    (*if co then if cn then "!" else "+" else if cn then "-" else "?"*)
-    ty
+  fprintf ppf "%s%s"
+    (if not cn then "+" else if not co then "-" else "")
+    (if ty = "_" then ty else "'"^ty)
 
 let print_out_class_params ppf =
   function
diff --git a/typing/printtyp.ml b/typing/printtyp.ml
index ed8b2e75f9..2b5470ea48 100644
--- a/typing/printtyp.ml
+++ b/typing/printtyp.ml
@@ -236,7 +236,8 @@ let name_of_type t =
           (* No name available, create a new one *)
           new_name ()
     in
-    names := (t, name) :: !names;
+    (* Exception for type declarations *)
+    if name <> "_" then names := (t, name) :: !names;
     name
 
 let check_name_of_type t = ignore(name_of_type t)
diff --git a/typing/typeclass.ml b/typing/typeclass.ml
index 34b651e186..512f7cf8b2 100644
--- a/typing/typeclass.ml
+++ b/typing/typeclass.ml
@@ -569,38 +569,6 @@ let rec class_field cl_num self_type meths vars
       type_constraint val_env sty sty' loc;
       (val_env, met_env, par_env, fields, concr_meths, warn_vals, inher)
 
-  | Pcf_let (rec_flag, sdefs, loc) ->
-      let (defs, val_env) =
-        try
-          Typecore.type_let val_env rec_flag sdefs None
-        with Ctype.Unify [(ty, _)] ->
-          raise(Error(loc, Make_nongen_seltype ty))
-      in
-      let (vals, met_env, par_env) =
-        List.fold_right
-          (fun id (vals, met_env, par_env) ->
-             let expr =
-               Typecore.type_exp val_env
-                 {pexp_desc = Pexp_ident (Longident.Lident (Ident.name id));
-                  pexp_loc = Location.none}
-             in
-             let desc =
-               {val_type = expr.exp_type;
-                val_kind = Val_ivar (Immutable, cl_num);
-                val_loc = Location.none;
-               }
-             in
-             let id' = Ident.create (Ident.name id) in
-             ((id', expr)
-              :: vals,
-              Env.add_value id' desc met_env,
-              Env.add_value id' desc par_env))
-          (let_bound_idents defs)
-          ([], met_env, par_env)
-      in
-      (val_env, met_env, par_env, lazy(Cf_let(rec_flag, defs, vals))::fields,
-       concr_meths, warn_vals, inher)
-
   | Pcf_init expr ->
       let expr = make_method cl_num expr in
       let vars_local = !vars in
diff --git a/typing/typecore.ml b/typing/typecore.ml
index a400bc23ea..9a7a1d849e 100644
--- a/typing/typecore.ml
+++ b/typing/typecore.ml
@@ -521,7 +521,7 @@ let rec type_pat ~constrs ~labels ~no_existentials ~mode ~env sp expected_ty =
       begin match ty.desc with
       | Tpoly (body, tyl) ->
           begin_def ();
-          let _, ty' = instance_poly false tyl body in
+          let _, ty' = instance_poly ~keep_names:true false tyl body in
           end_def ();
           generalize ty';
           let id = enter_variable loc name ty' in
@@ -870,7 +870,7 @@ let rec is_nonexpansive exp =
             Cf_meth _ -> true
           | Cf_val (_,_,e,_) -> incr count; is_nonexpansive_opt e
           | Cf_init e -> is_nonexpansive e
-          | Cf_inher _ | Cf_let _ -> false)
+          | Cf_inher _ -> false)
         fields &&
       Vars.fold (fun _ (mut,_,_) b -> decr count; b && mut = Immutable)
         vars true &&
@@ -907,7 +907,7 @@ and is_nonexpansive_opt = function
 
 (* Typing format strings for printing or reading.
 
-   This format strings are used by functions in modules Printf, Format, and
+   These format strings are used by functions in modules Printf, Format, and
    Scanf.
 
    (Handling of * modifiers contributed by Thorsten Ohl.) *)
@@ -926,25 +926,6 @@ let type_format loc fmt =
   let incomplete_format fmt =
     raise (Error (loc, Incomplete_format fmt)) in
 
-  let range_closing_index fmt i =
-
-    let len = String.length fmt in
-    let find_closing j =
-      if j >= len then incomplete_format fmt else
-      try String.index_from fmt j ']' with
-      | Not_found -> incomplete_format fmt in
-    let skip_pos j =
-      if j >= len then incomplete_format fmt else
-      match fmt.[j] with
-      | ']' -> find_closing (j + 1)
-      | c -> find_closing j in
-    let rec skip_neg j =
-      if j >= len then incomplete_format fmt else
-      match fmt.[j] with
-      | '^' -> skip_pos (j + 1)
-      | c -> skip_pos j in
-    find_closing (skip_neg (i + 1)) in
-
   let rec type_in_format fmt =
 
     let len = String.length fmt in
@@ -963,14 +944,7 @@ let type_format loc fmt =
         else incomplete_format fmt else
       match fmt.[i] with
       | '%' -> scan_opts i (i + 1)
-      | '@' -> skip_indication (i + 1)
       | _ -> scan_format (i + 1)
-    and skip_indication i =
-      if i >= len then incomplete_format fmt else
-      match fmt.[i] with
-      | '@' | '%' -> scan_format (i + 1)
-      | _ -> scan_format i
-
     and scan_opts i j =
       if j >= len then incomplete_format fmt else
       match fmt.[j] with
@@ -1001,6 +975,48 @@ let type_format loc fmt =
         match fmt.[j] with
         | '.' -> scan_width_or_prec_value scan_conversion i (j + 1)
         | _ -> scan_conversion i j
+      and scan_indication j =
+        if j >= len then j - 1 else
+        match fmt.[j] with
+        | '@' ->
+          let k = j + 1 in
+          if k >= len then j - 1 else
+          begin match fmt.[k] with
+          | '%' ->
+            let k = k + 1 in
+            if k >= len then j - 1 else
+            begin match fmt.[k] with
+            | '%' | '@' -> k
+            | _c -> j - 1
+            end
+          | _c -> k
+          end
+        | _c -> j - 1
+      and scan_range j =
+        let rec scan_closing j =
+          if j >= len then incomplete_format fmt else
+          match fmt.[j] with
+          | ']' -> j
+          | '%' ->
+            let j = j + 1 in
+            if j >= len then incomplete_format fmt else
+            begin match fmt.[j] with
+            | '%' | '@' -> scan_closing (j + 1)
+            | c -> bad_conversion fmt j c
+            end
+          | c -> scan_closing (j + 1) in
+        let scan_first_pos j =
+          if j >= len then incomplete_format fmt else
+          match fmt.[j] with
+          | ']' -> scan_closing (j + 1)
+          | c -> scan_closing j in
+        let rec scan_first_neg j =
+          if j >= len then incomplete_format fmt else
+          match fmt.[j] with
+          | '^' -> scan_first_pos (j + 1)
+          | c -> scan_first_pos j in
+
+        scan_first_neg j
 
       and conversion j ty_arg =
         let ty_uresult, ty_result = scan_format (j + 1) in
@@ -1020,13 +1036,16 @@ let type_format loc fmt =
       and scan_conversion i j =
         if j >= len then incomplete_format fmt else
         match fmt.[j] with
-        | '%' | '!' | ',' -> scan_format (j + 1)
-        | 's' | 'S' -> conversion j Predef.type_string
+        | '%' | '@' | '!' | ',' -> scan_format (j + 1)
+        | 's' | 'S' ->
+          let j = scan_indication (j + 1) in
+          conversion j Predef.type_string
         | '[' ->
-          let j = range_closing_index fmt j in
+          let j = scan_range (j + 1) in
+          let j = scan_indication (j + 1) in
           conversion j Predef.type_string
         | 'c' | 'C' -> conversion j Predef.type_char
-        | 'd' | 'i' | 'o' | 'x' | 'X' | 'u' | 'N' ->
+        | 'd' | 'i' | 'o' | 'u' | 'x' | 'X' | 'N' ->
           conversion j Predef.type_int
         | 'f' | 'e' | 'E' | 'g' | 'G' | 'F' -> conversion j Predef.type_float
         | 'B' | 'b' -> conversion j Predef.type_bool
@@ -1055,7 +1074,7 @@ let type_format loc fmt =
           let j = j + 1 in
           if j >= len then conversion (j - 1) Predef.type_int else begin
             match fmt.[j] with
-            | 'd' | 'i' | 'o' | 'x' | 'X' | 'u' ->
+            | 'd' | 'i' | 'o' | 'u' | 'x' | 'X' ->
               let ty_arg =
                 match c with
                 | 'l' -> Predef.type_int32
@@ -1084,9 +1103,10 @@ let type_format loc fmt =
     let ty_ureader, ty_args = scan_format 0 in
     newty
       (Tconstr
-         (Predef.path_format6,
-          [ty_args; ty_input; ty_aresult; ty_ureader; ty_uresult; ty_result],
-          ref Mnil)) in
+        (Predef.path_format6,
+         [ ty_args; ty_input; ty_aresult;
+           ty_ureader; ty_uresult; ty_result; ],
+         ref Mnil)) in
 
   type_in_format fmt
 
@@ -2633,7 +2653,8 @@ and type_let ?(check = fun s -> Warnings.Unused_var s) ?(check_strict = fun s ->
         let pat =
           match pat.pat_type.desc with
           | Tpoly (ty, tl) ->
-              {pat with pat_type = snd (instance_poly false tl ty)}
+              {pat with pat_type =
+               snd (instance_poly ~keep_names:true false tl ty)}
           | _ -> pat
         in unify_pat env pat (type_approx env sexp))
       pat_list spat_sexp_list;
@@ -2722,7 +2743,7 @@ and type_let ?(check = fun s -> Warnings.Unused_var s) ?(check_strict = fun s ->
         | Tpoly (ty, tl) ->
             begin_def ();
             if !Clflags.principal then begin_def ();
-            let vars, ty' = instance_poly true tl ty in
+            let vars, ty' = instance_poly ~keep_names:true true tl ty in
             if !Clflags.principal then begin
               end_def ();
               generalize_structure ty'
@@ -2744,8 +2765,7 @@ and type_let ?(check = fun s -> Warnings.Unused_var s) ?(check_strict = fun s ->
          iter_pattern (fun pat -> generalize_expansive env pat.pat_type) pat)
     pat_list exp_list;
   List.iter
-    (fun pat -> iter_pattern
-      (fun pat -> generalize pat.pat_type) pat)
+    (fun pat -> iter_pattern (fun pat -> generalize pat.pat_type) pat)
     pat_list;
   (List.combine pat_list exp_list, new_env, unpacks)
 
@@ -2775,7 +2795,12 @@ let type_expression env sexp =
   end_def();
   if is_nonexpansive exp then generalize exp.exp_type
   else generalize_expansive env exp.exp_type;
-  exp
+  match sexp.pexp_desc with
+    Pexp_ident lid ->
+      (* Special case for keeping type variables when looking-up a variable *)
+      let (path, desc) = Env.lookup_value lid env in
+      {exp with exp_type = desc.val_type}
+  | _ -> exp
 
 (* Error report *)
 
diff --git a/typing/typedecl.ml b/typing/typedecl.ml
index 94e09cc574..315e066d16 100644
--- a/typing/typedecl.ml
+++ b/typing/typedecl.ml
@@ -125,16 +125,11 @@ module StringSet =
   end)
 
 let make_params sdecl =
-  let param_counter = ref 0 in 
   try 
     List.map 
       (function
-	  None ->
-	    incr param_counter ;
-	    enter_type_variable true sdecl.ptype_loc
-	      (Printf.sprintf "*%d" !param_counter)
-	| Some x ->
-	    enter_type_variable true sdecl.ptype_loc x)
+	  None -> Ctype.new_global_var ~name:"_" ()
+	| Some x -> enter_type_variable true sdecl.ptype_loc x)
       sdecl.ptype_params
   with Already_bound ->
     raise(Error(sdecl.ptype_loc, Repeated_parameter))
diff --git a/typing/typedtree.ml b/typing/typedtree.ml
index 3b43d1d80f..0feca199a3 100644
--- a/typing/typedtree.ml
+++ b/typing/typedtree.ml
@@ -110,8 +110,6 @@ and class_field =
     Cf_inher of class_expr * (string * Ident.t) list * (string * Ident.t) list
   | Cf_val of string * Ident.t * expression option * bool
   | Cf_meth of string * expression
-  | Cf_let of rec_flag * (pattern * expression) list *
-              (Ident.t * expression) list
   | Cf_init of expression
 
 (* Value expressions for the module language *)
diff --git a/typing/typedtree.mli b/typing/typedtree.mli
index 15acb6ac59..0c5efa8ea8 100644
--- a/typing/typedtree.mli
+++ b/typing/typedtree.mli
@@ -112,8 +112,6 @@ and class_field =
   | Cf_val of string * Ident.t * expression option * bool
         (* None = virtual, true = override *)
   | Cf_meth of string * expression
-  | Cf_let of rec_flag * (pattern * expression) list *
-              (Ident.t * expression) list
   | Cf_init of expression
 
 (* Value expressions for the module language *)
diff --git a/typing/unused_var.ml b/typing/unused_var.ml
index 61123eff50..3a6eeaeb50 100644
--- a/typing/unused_var.ml
+++ b/typing/unused_var.ml
@@ -274,7 +274,6 @@ and class_field ppf tbl cf =
   | Pcf_virt _ | Pcf_valvirt _ -> ()
   | Pcf_meth (_, _, _, e, _) -> expression ppf tbl e;
   | Pcf_cstr _ -> ()
-  | Pcf_let (recflag, pel, _) -> let_pel ppf tbl recflag pel None;
   | Pcf_init e -> expression ppf tbl e;
 ;;
 
diff --git a/utils/ccomp.ml b/utils/ccomp.ml
index 881223ef9f..66525e5b9e 100644
--- a/utils/ccomp.ml
+++ b/utils/ccomp.ml
@@ -73,9 +73,10 @@ let create_archive archive file_list =
       command(Printf.sprintf "link /lib /nologo /out:%s %s"
                              quoted_archive (quote_files file_list))
   | _ ->
+      assert(String.length Config.ar > 0);
       let r1 =
-        command(Printf.sprintf "ar rc %s %s"
-                quoted_archive (quote_files file_list)) in
+        command(Printf.sprintf "%s rc %s %s"
+                Config.ar quoted_archive (quote_files file_list)) in
       if r1 <> 0 || String.length Config.ranlib = 0
       then r1
       else command(Config.ranlib ^ " " ^ quoted_archive)
diff --git a/utils/config.mlbuild b/utils/config.mlbuild
index 1598bee52c..367c204e7b 100644
--- a/utils/config.mlbuild
+++ b/utils/config.mlbuild
@@ -55,6 +55,7 @@ let native_c_compiler = sf "%s %s" C.nativecc C.nativecccompopts
 let native_c_libraries = C.nativecclibs
 let native_pack_linker = C.packld
 let ranlib = C.ranlibcmd
+let ar = C.arcmd
 let cc_profile = C.cc_profile
 let mkdll = C.mkdll
 let mkexe = C.mkexe
diff --git a/utils/config.mli b/utils/config.mli
index 897edb6da2..78fe77c6af 100644
--- a/utils/config.mli
+++ b/utils/config.mli
@@ -46,6 +46,8 @@ val mkmaindll: string
         (* The linker command line to build main programs as dlls. *)
 val ranlib: string
         (* Command to randomize a library, or "" if not needed *)
+val ar: string
+        (* Name of the ar command, or "" if not needed  (MSVC) *)
 val cc_profile : string
         (* The command line option to the C compiler to enable profiling. *)
 
diff --git a/utils/config.mlp b/utils/config.mlp
index 1883cfa520..35e56e7513 100644
--- a/utils/config.mlp
+++ b/utils/config.mlp
@@ -44,6 +44,7 @@ let native_c_compiler = "%%NATIVECC%%"
 let native_c_libraries = "%%NATIVECCLIBS%%"
 let native_pack_linker = "%%PACKLD%%"
 let ranlib = "%%RANLIBCMD%%"
+let ar = "%%ARCMD%%"
 let cc_profile = "%%CC_PROFILE%%"
 let mkdll = "%%MKDLL%%"
 let mkexe = "%%MKEXE%%"
diff --git a/utils/warnings.ml b/utils/warnings.ml
index 46a01e2440..1f99b63c82 100644
--- a/utils/warnings.ml
+++ b/utils/warnings.ml
@@ -50,12 +50,13 @@ type t =
   | Wildcard_arg_to_constant_constr         (* 28 *)
   | Eol_in_string                           (* 29 *)
   | Duplicate_definitions of string * string * string * string (*30 *)
-  | Unused_value_declaration of string      (* 31 *)
-  | Unused_open of string                   (* 32 *)
-  | Unused_type_declaration of string       (* 33 *)
-  | Unused_for_index of string              (* 34 *)
-  | Unused_ancestor of string               (* 35 *)
-  | Unused_constructor of string            (* 36 *)
+  | Multiple_definition of string * string * string (* 31 *)
+  | Unused_value_declaration of string      (* 32 *)
+  | Unused_open of string                   (* 33 *)
+  | Unused_type_declaration of string       (* 34 *)
+  | Unused_for_index of string              (* 35 *)
+  | Unused_ancestor of string               (* 36 *)
+  | Unused_constructor of string            (* 37 *)
 ;;
 
 (* If you remove a warning, leave a hole in the numbering.  NEVER change
@@ -95,15 +96,16 @@ let number = function
   | Wildcard_arg_to_constant_constr -> 28
   | Eol_in_string -> 29
   | Duplicate_definitions _ -> 30
-  | Unused_value_declaration _ -> 31
-  | Unused_open _ -> 32
-  | Unused_type_declaration _ -> 33
-  | Unused_for_index _ -> 34
-  | Unused_ancestor _ -> 35
-  | Unused_constructor _ -> 36
+  | Multiple_definition _ -> 31
+  | Unused_value_declaration _ -> 32
+  | Unused_open _ -> 33
+  | Unused_type_declaration _ -> 34
+  | Unused_for_index _ -> 35
+  | Unused_ancestor _ -> 36
+  | Unused_constructor _ -> 37
 ;;
 
-let last_warning_number = 36;;
+let last_warning_number = 37;;
 (* Must be the max number returned by the [number] function. *)
 
 let letter = function
@@ -198,7 +200,7 @@ let parse_opt flags s =
 let parse_options errflag s = parse_opt (if errflag then error else active) s;;
 
 (* If you change these, don't forget to change them in man/ocamlc.m *)
-let defaults_w = "+a-4-6-7-9-27-29-31-32-33-34-35-36";;
+let defaults_w = "+a-4-6-7-9-27-29-32-33-34-35-36-37";;
 let defaults_warn_error = "-a";;
 
 let () = parse_options false defaults_w;;
@@ -272,6 +274,10 @@ let message = function
   | Duplicate_definitions (kind, cname, tc1, tc2) ->
       Printf.sprintf "the %s %s is defined in both types %s and %s."
         kind cname tc1 tc2
+  | Multiple_definition(modname, file1, file2) ->
+      Printf.sprintf
+        "files %s and %s both define a module named %s"
+        file1 file2 modname
   | Unused_value_declaration v -> "unused value " ^ v ^ "."
   | Unused_open s -> "unused open " ^ s ^ "."
   | Unused_type_declaration s -> "unused type " ^ s ^ "."
@@ -352,12 +358,13 @@ let descriptions =
    29, "Unescaped end-of-line in a string constant (non-portable code).";
    30, "Two labels or constructors of the same name are defined in two\n\
    \    mutually recursive types.";
-   31, "Unused value declaration.";
-   32, "Unused open statement.";
-   33, "Unused type declaration.";
-   34, "Unused for-loop index.";
-   35, "Unused ancestor variable.";
-   36, "Unused constructor.";
+   31, "A module is linked twice in the same executable.";
+   32, "Unused value declaration.";
+   33, "Unused open statement.";
+   34, "Unused type declaration.";
+   35, "Unused for-loop index.";
+   36, "Unused ancestor variable.";
+   37, "Unused constructor.";
   ]
 ;;
 
diff --git a/utils/warnings.mli b/utils/warnings.mli
index 1c2c66a49e..99c153ffd6 100644
--- a/utils/warnings.mli
+++ b/utils/warnings.mli
@@ -45,12 +45,13 @@ type t =
   | Wildcard_arg_to_constant_constr         (* 28 *)
   | Eol_in_string                           (* 29 *)
   | Duplicate_definitions of string * string * string * string (*30 *)
-  | Unused_value_declaration of string      (* 31 *)
-  | Unused_open of string                   (* 32 *)
-  | Unused_type_declaration of string       (* 33 *)
-  | Unused_for_index of string              (* 34 *)
-  | Unused_ancestor of string               (* 35 *)
-  | Unused_constructor of string            (* 36 *)
+  | Multiple_definition of string * string * string (* 31 *)
+  | Unused_value_declaration of string      (* 32 *)
+  | Unused_open of string                   (* 33 *)
+  | Unused_type_declaration of string       (* 34 *)
+  | Unused_for_index of string              (* 35 *)
+  | Unused_ancestor of string               (* 36 *)
+  | Unused_constructor of string            (* 37 *)
 ;;
 
 val parse_options : bool -> string -> unit;;