merge trunkgadts-devel

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

47 files changed, 879 insertions, 677 deletions

diff --git a/.depend b/.depend
index 597f897983..04e314e3df 100644
--- a/.depend
+++ b/.depend
@@ -101,8 +101,8 @@ typing/typedtree.cmi: typing/types.cmi typing/primitive.cmi typing/path.cmi \
 typing/typemod.cmi: typing/types.cmi typing/typedtree.cmi \
     parsing/parsetree.cmi parsing/longident.cmi parsing/location.cmi \
     typing/includemod.cmi typing/ident.cmi typing/env.cmi
-typing/types.cmi: typing/primitive.cmi typing/path.cmi typing/ident.cmi \
-    parsing/asttypes.cmi
+typing/types.cmi: typing/primitive.cmi typing/path.cmi parsing/location.cmi \
+    typing/ident.cmi parsing/asttypes.cmi
 typing/typetexp.cmi: typing/types.cmi typing/path.cmi parsing/parsetree.cmi \
     parsing/longident.cmi parsing/location.cmi typing/env.cmi
 typing/unused_var.cmi: parsing/parsetree.cmi
@@ -111,11 +111,13 @@ typing/btype.cmo: typing/types.cmi typing/path.cmi utils/misc.cmi \
 typing/btype.cmx: typing/types.cmx typing/path.cmx utils/misc.cmx \
     typing/btype.cmi
 typing/ctype.cmo: typing/types.cmi typing/subst.cmi typing/path.cmi \
-    utils/misc.cmi parsing/longident.cmi typing/ident.cmi typing/env.cmi \
-    utils/clflags.cmi typing/btype.cmi parsing/asttypes.cmi typing/ctype.cmi
+    utils/misc.cmi parsing/longident.cmi parsing/location.cmi \
+    typing/ident.cmi typing/env.cmi utils/clflags.cmi typing/btype.cmi \
+    parsing/asttypes.cmi typing/ctype.cmi
 typing/ctype.cmx: typing/types.cmx typing/subst.cmx typing/path.cmx \
-    utils/misc.cmx parsing/longident.cmx typing/ident.cmx typing/env.cmx \
-    utils/clflags.cmx typing/btype.cmx parsing/asttypes.cmi typing/ctype.cmi
+    utils/misc.cmx parsing/longident.cmx parsing/location.cmx \
+    typing/ident.cmx typing/env.cmx utils/clflags.cmx typing/btype.cmx \
+    parsing/asttypes.cmi typing/ctype.cmi
 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 \
@@ -144,12 +146,14 @@ typing/includecore.cmx: typing/types.cmx typing/typedtree.cmx \
     typing/btype.cmx parsing/asttypes.cmi typing/includecore.cmi
 typing/includemod.cmo: typing/types.cmi typing/typedtree.cmi utils/tbl.cmi \
     typing/subst.cmi typing/printtyp.cmi typing/path.cmi typing/mtype.cmi \
-    utils/misc.cmi typing/includecore.cmi typing/includeclass.cmi \
-    typing/ident.cmi typing/env.cmi typing/ctype.cmi typing/includemod.cmi
+    utils/misc.cmi parsing/location.cmi typing/includecore.cmi \
+    typing/includeclass.cmi typing/ident.cmi typing/env.cmi typing/ctype.cmi \
+    utils/clflags.cmi typing/includemod.cmi
 typing/includemod.cmx: typing/types.cmx typing/typedtree.cmx utils/tbl.cmx \
     typing/subst.cmx typing/printtyp.cmx typing/path.cmx typing/mtype.cmx \
-    utils/misc.cmx typing/includecore.cmx typing/includeclass.cmx \
-    typing/ident.cmx typing/env.cmx typing/ctype.cmx typing/includemod.cmi
+    utils/misc.cmx parsing/location.cmx typing/includecore.cmx \
+    typing/includeclass.cmx typing/ident.cmx typing/env.cmx typing/ctype.cmx \
+    utils/clflags.cmx typing/includemod.cmi
 typing/mtype.cmo: typing/types.cmi typing/subst.cmi typing/path.cmi \
     typing/ident.cmi typing/env.cmi typing/ctype.cmi utils/clflags.cmi \
     typing/btype.cmi parsing/asttypes.cmi typing/mtype.cmi
@@ -172,10 +176,10 @@ typing/parmatch.cmx: utils/warnings.cmx typing/types.cmx typing/typedtree.cmx \
     typing/btype.cmx parsing/asttypes.cmi typing/parmatch.cmi
 typing/path.cmo: typing/ident.cmi typing/path.cmi
 typing/path.cmx: typing/ident.cmx typing/path.cmi
-typing/predef.cmo: typing/types.cmi typing/path.cmi typing/ident.cmi \
-    typing/btype.cmi parsing/asttypes.cmi typing/predef.cmi
-typing/predef.cmx: typing/types.cmx typing/path.cmx typing/ident.cmx \
-    typing/btype.cmx parsing/asttypes.cmi typing/predef.cmi
+typing/predef.cmo: typing/types.cmi typing/path.cmi parsing/location.cmi \
+    typing/ident.cmi typing/btype.cmi parsing/asttypes.cmi typing/predef.cmi
+typing/predef.cmx: typing/types.cmx typing/path.cmx parsing/location.cmx \
+    typing/ident.cmx typing/btype.cmx parsing/asttypes.cmi typing/predef.cmi
 typing/primitive.cmo: utils/misc.cmi typing/primitive.cmi
 typing/primitive.cmx: utils/misc.cmx typing/primitive.cmi
 typing/printtyp.cmo: typing/types.cmi typing/primitive.cmi typing/predef.cmi \
@@ -193,9 +197,11 @@ typing/stypes.cmo: typing/typedtree.cmi typing/printtyp.cmi \
 typing/stypes.cmx: typing/typedtree.cmx typing/printtyp.cmx \
     parsing/location.cmx utils/clflags.cmx typing/annot.cmi typing/stypes.cmi
 typing/subst.cmo: typing/types.cmi utils/tbl.cmi typing/path.cmi \
-    utils/misc.cmi typing/ident.cmi typing/btype.cmi typing/subst.cmi
+    utils/misc.cmi parsing/location.cmi typing/ident.cmi typing/btype.cmi \
+    typing/subst.cmi
 typing/subst.cmx: typing/types.cmx utils/tbl.cmx typing/path.cmx \
-    utils/misc.cmx typing/ident.cmx typing/btype.cmx typing/subst.cmi
+    utils/misc.cmx parsing/location.cmx typing/ident.cmx typing/btype.cmx \
+    typing/subst.cmi
 typing/typeclass.cmo: utils/warnings.cmi typing/typetexp.cmi typing/types.cmi \
     typing/typedtree.cmi typing/typedecl.cmi typing/typecore.cmi \
     typing/subst.cmi typing/stypes.cmi typing/printtyp.cmi typing/predef.cmi \
@@ -263,9 +269,11 @@ typing/typemod.cmx: utils/warnings.cmx typing/typetexp.cmx typing/types.cmx \
     typing/env.cmx typing/ctype.cmx utils/config.cmx utils/clflags.cmx \
     typing/btype.cmx parsing/asttypes.cmi typing/annot.cmi typing/typemod.cmi
 typing/types.cmo: typing/primitive.cmi typing/path.cmi utils/misc.cmi \
-    typing/ident.cmi parsing/asttypes.cmi typing/types.cmi
+    parsing/location.cmi typing/ident.cmi parsing/asttypes.cmi \
+    typing/types.cmi
 typing/types.cmx: typing/primitive.cmx typing/path.cmx utils/misc.cmx \
-    typing/ident.cmx parsing/asttypes.cmi typing/types.cmi
+    parsing/location.cmx typing/ident.cmx parsing/asttypes.cmi \
+    typing/types.cmi
 typing/typetexp.cmo: utils/warnings.cmi typing/types.cmi utils/tbl.cmi \
     typing/printtyp.cmi typing/path.cmi parsing/parsetree.cmi utils/misc.cmi \
     parsing/longident.cmi parsing/location.cmi typing/env.cmi \
diff --git a/Changes b/Changes
index aa4dd06377..1ff85042c2 100644
--- a/Changes
+++ b/Changes
@@ -5,8 +5,9 @@ OCaml 3.13.0:
 - Warning 28 is now enabled by default.
 
 Language features:
-- Added GADTs to the language. See testsuite/tests/typing-gadts for
-  the syntax and some examples of use. Please use -principal for testing.
+- Added Generalized Abstract Data Types (GADTs) to the language. See
+  testsuite/tests/typing-gadts for the syntax and some examples of
+  use. Please use -principal for testing.
 - It is now possible to omit type annotations when packing and unpacking
   first-class modules. The type-checker attempts to infer it from the context.
   Using the -principal option guarantees forward compatibility.
diff --git a/Makefile b/Makefile
index 46291acc97..94c069f604 100644
--- a/Makefile
+++ b/Makefile
@@ -113,6 +113,7 @@ OPTOBJS=$(OPTUTILS) $(PARSING) $(TYPING) $(COMP) $(ASMCOMP) $(OPTDRIVER)
 EXPUNGEOBJS=utils/misc.cmo utils/tbl.cmo \
   utils/config.cmo utils/clflags.cmo \
   typing/ident.cmo typing/path.cmo typing/types.cmo typing/btype.cmo \
+  utils/warnings.cmo parsing/location.cmo \
   typing/predef.cmo bytecomp/runtimedef.cmo bytecomp/bytesections.cmo \
   bytecomp/dll.cmo bytecomp/meta.cmo bytecomp/symtable.cmo toplevel/expunge.cmo
 
diff --git a/VERSION b/VERSION
index 917b0d230e..fe54d2adb4 100644
--- a/VERSION
+++ b/VERSION
@@ -1,4 +1,4 @@
-3.13.0+dev7 (2011-09-22)
+3.13.0+dev8 (2011-10-25)
 
 # The version string is the first line of this file.
 # It must be in the format described in stdlib/sys.mli
diff --git a/asmrun/amd64.S b/asmrun/amd64.S
index b960ea8026..ff031dd5f6 100644
--- a/asmrun/amd64.S
+++ b/asmrun/amd64.S
@@ -20,6 +20,7 @@
 
 #ifdef SYS_macosx
 
+#define LBL(x) L##x	
 #define G(r) _##r
 #define GREL(r) _##r@GOTPCREL
 #define GCALL(r) _##r
@@ -33,6 +34,7 @@
 
 #else
 
+#define LBL(x) .L##x	
 #define G(r) r
 #define GREL(r) r@GOTPCREL
 #define GCALL(r) r@PLT
@@ -126,7 +128,7 @@
 
 FUNCTION(G(caml_call_gc))
         RECORD_STACK_FRAME(0)
-.Lcaml_call_gc:
+LBL(caml_call_gc):
     /* Build array of registers, save it into caml_gc_regs */
         pushq   %r13
         pushq   %r12
@@ -203,62 +205,62 @@ FUNCTION(G(caml_call_gc))
         ret
 
 FUNCTION(G(caml_alloc1))
-.Lcaml_alloc1:
+LBL(caml_alloc1):
         subq    $16, %r15
         CMP_VAR(caml_young_limit, %r15)
-        jb      .L100
+        jb      LBL(100)
         ret
-.L100:
+LBL(100):
         RECORD_STACK_FRAME(0)
 	subq	$8, %rsp
-        call    .Lcaml_call_gc
+        call    LBL(caml_call_gc)
 	addq	$8, %rsp
-        jmp     .Lcaml_alloc1
+        jmp     LBL(caml_alloc1)
 
 FUNCTION(G(caml_alloc2))
-.Lcaml_alloc2:
+LBL(caml_alloc2):
         subq    $24, %r15
         CMP_VAR(caml_young_limit, %r15)
-        jb      .L101
+        jb      LBL(101)
         ret
-.L101:
+LBL(101):
         RECORD_STACK_FRAME(0)
 	subq	$8, %rsp
-        call    .Lcaml_call_gc
+        call    LBL(caml_call_gc)
 	addq	$8, %rsp
-        jmp     .Lcaml_alloc2
+        jmp     LBL(caml_alloc2)
 
 FUNCTION(G(caml_alloc3))
-.Lcaml_alloc3:
+LBL(caml_alloc3):
         subq    $32, %r15
         CMP_VAR(caml_young_limit, %r15)
-        jb      .L102
+        jb      LBL(102)
         ret
-.L102:
+LBL(102):
         RECORD_STACK_FRAME(0)
 	subq	$8, %rsp
-        call    .Lcaml_call_gc
+        call    LBL(caml_call_gc)
 	addq	$8, %rsp
-        jmp     .Lcaml_alloc3
+        jmp     LBL(caml_alloc3)
 
 FUNCTION(G(caml_allocN))
-.Lcaml_allocN:
+LBL(caml_allocN):
         pushq   %rax                       /* save desired size */
         subq    %rax, %r15
         CMP_VAR(caml_young_limit, %r15)
-        jb      .L103
+        jb      LBL(103)
         addq    $8, %rsp                  /* drop desired size */
         ret
-.L103:
+LBL(103):
         RECORD_STACK_FRAME(8)
-        call    .Lcaml_call_gc
+        call    LBL(caml_call_gc)
         popq    %rax                      /* recover desired size */
-        jmp     .Lcaml_allocN
+        jmp     LBL(caml_allocN)
 
 /* Call a C function from Caml */
 
 FUNCTION(G(caml_c_call))
-.Lcaml_c_call:
+LBL(caml_c_call):
     /* Record lowest stack address and return address */
         popq    %r12
         STORE_VAR(%r12, caml_last_return_address)
@@ -288,7 +290,7 @@ FUNCTION(G(caml_start_program))
     /* Initial entry point is G(caml_program) */
         leaq    GCALL(caml_program)(%rip), %r12
     /* Common code for caml_start_program and caml_callback* */
-.Lcaml_start_program:
+LBL(caml_start_program):
     /* Build a callback link */
 	subq	$8, %rsp	/* stack 16-aligned */
         PUSH_VAR(caml_gc_regs)
@@ -298,17 +300,17 @@ FUNCTION(G(caml_start_program))
 	LOAD_VAR(caml_young_ptr, %r15)
 	LOAD_VAR(caml_exception_pointer, %r14)
     /* Build an exception handler */
-        lea     .L108(%rip), %r13
+        lea     LBL(108)(%rip), %r13
         pushq   %r13
         pushq   %r14
         movq    %rsp, %r14
     /* Call the Caml code */
         call    *%r12
-.L107:
+LBL(107):
     /* Pop the exception handler */
         popq    %r14
         popq    %r12    /* dummy register */
-.L109:
+LBL(109):
     /* Update alloc ptr and exception ptr */
 	STORE_VAR(%r15,caml_young_ptr)
 	STORE_VAR(%r14,caml_exception_pointer)
@@ -327,21 +329,21 @@ FUNCTION(G(caml_start_program))
         popq    %rbx
     /* Return to caller. */
         ret
-.L108:
+LBL(108):
     /* Exception handler*/
     /* Mark the bucket as an exception result and return it */
         orq     $2, %rax
-        jmp     .L109
+        jmp     LBL(109)
 
 /* Raise an exception from Caml */
 
 FUNCTION(G(caml_raise_exn))
         TESTL_VAR($1, caml_backtrace_active)
-        jne     .L110
+        jne     LBL(110)
         movq    %r14, %rsp
         popq    %r14
         ret
-.L110:
+LBL(110):
         movq    %rax, %r12            /* Save exception bucket */
         movq    %rax, %rdi            /* arg 1: exception bucket */
         movq    0(%rsp), %rsi         /* arg 2: pc of raise */
@@ -357,13 +359,13 @@ FUNCTION(G(caml_raise_exn))
 
 FUNCTION(G(caml_raise_exception))
         TESTL_VAR($1, caml_backtrace_active)
-        jne     .L111
+        jne     LBL(111)
         movq    %rdi, %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
-.L111:
+LBL(111):
         movq    %rdi, %r12            /* Save exception bucket */
                                       /* arg 1: exception bucket */
 	LOAD_VAR(caml_last_return_address,%rsi)   /* arg 2: pc of raise */
@@ -391,7 +393,7 @@ FUNCTION(G(caml_callback_exn))
         movq    %rdi, %rbx      /* closure */
         movq    %rsi, %rax      /* argument */
         movq    0(%rbx), %r12   /* code pointer */
-        jmp     .Lcaml_start_program
+        jmp     LBL(caml_start_program)
 
 FUNCTION(G(caml_callback2_exn))
     /* Save callee-save registers */
@@ -407,7 +409,7 @@ FUNCTION(G(caml_callback2_exn))
         movq    %rsi, %rax               /* first argument */
         movq    %rdx, %rbx               /* second argument */
         leaq    GCALL(caml_apply2)(%rip), %r12  /* code pointer */
-        jmp     .Lcaml_start_program
+        jmp     LBL(caml_start_program)
 
 FUNCTION(G(caml_callback3_exn))
     /* Save callee-save registers */
@@ -424,18 +426,18 @@ FUNCTION(G(caml_callback3_exn))
         movq    %rdi, %rsi               /* closure */
         movq    %rcx, %rdi               /* third argument */
         leaq    GCALL(caml_apply3)(%rip), %r12  /* code pointer */
-        jmp     .Lcaml_start_program
+        jmp     LBL(caml_start_program)
 
 FUNCTION(G(caml_ml_array_bound_error))
         leaq    GCALL(caml_array_bound_error)(%rip), %rax
-        jmp     .Lcaml_c_call
+        jmp     LBL(caml_c_call)
 
         .data
         .globl  G(caml_system__frametable)
         .align  EIGHT_ALIGN
 G(caml_system__frametable):
         .quad   1           /* one descriptor */
-        .quad   .L107       /* return address into callback */
+        .quad   LBL(107)    /* return address into callback */
         .value  -1          /* negative frame size => use callback link */
         .value  0           /* no roots here */
         .align  EIGHT_ALIGN
diff --git a/boot/ocamlc b/boot/ocamlc
index f5f0cf44a1..29b2110fde 100755
--- a/boot/ocamlc
+++ b/boot/ocamlc
diff --git a/boot/ocamldep b/boot/ocamldep
index bcbc7bebad..bf492825bc 100755
--- a/boot/ocamldep
+++ b/boot/ocamldep
diff --git a/boot/ocamllex b/boot/ocamllex
index e9fc078adc..ec5302a3d8 100755
--- a/boot/ocamllex
+++ b/boot/ocamllex
diff --git a/bytecomp/translcore.ml b/bytecomp/translcore.ml
index 9441fcc684..8fb005f173 100644
--- a/bytecomp/translcore.ml
+++ b/bytecomp/translcore.ml
@@ -481,7 +481,9 @@ let rec push_defaults loc bindings pat_expr_list partial =
           Texp_match
             ({exp with exp_type = pat.pat_type; exp_desc =
               Texp_ident (Path.Pident param,
-                          {val_type = pat.pat_type; val_kind = Val_reg})},
+                          {val_type = pat.pat_type; val_kind = Val_reg;
+                           val_loc = Location.none;
+                          })},
              pat_expr_list, partial) }
       in
       push_defaults loc bindings
diff --git a/debugger/Makefile.shared b/debugger/Makefile.shared
index 77b9c60e01..820af9af9e 100644
--- a/debugger/Makefile.shared
+++ b/debugger/Makefile.shared
@@ -29,9 +29,9 @@ INCLUDES=\
 
 OTHEROBJS=\
   $(UNIXDIR)/unix.cma \
-  ../utils/misc.cmo ../utils/config.cmo \
-  ../utils/tbl.cmo ../utils/clflags.cmo ../utils/consistbl.cmo \
-  ../parsing/longident.cmo \
+  ../utils/misc.cmo ../utils/config.cmo ../utils/tbl.cmo \
+  ../utils/clflags.cmo ../utils/consistbl.cmo ../utils/warnings.cmo \
+  ../parsing/location.cmo ../parsing/longident.cmo \
   ../typing/ident.cmo ../typing/path.cmo ../typing/types.cmo \
   ../typing/btype.cmo ../typing/primitive.cmo ../typing/typedtree.cmo \
   ../typing/subst.cmo ../typing/predef.cmo \
diff --git a/ocamldoc/odoc_info.ml b/ocamldoc/odoc_info.ml
index 061d091f53..047fa2b5bb 100644
--- a/ocamldoc/odoc_info.ml
+++ b/ocamldoc/odoc_info.ml
@@ -213,12 +213,12 @@ let info_string_of_info i =
    | Some t -> p b "%s" (escape_arobas (text_string_of_text t))
   );
   List.iter
-    (fun s -> p b "\n@author %s" (escape_arobas s))
+    (fun s -> p b "\n@@author %s" (escape_arobas s))
     i.i_authors;
   (
    match i.i_version with
      None -> ()
-   | Some s -> p b "\n@version %s" (escape_arobas s)
+   | Some s -> p b "\n@@version %s" (escape_arobas s)
   );
   (
    (* TODO: escape characters ? *)
@@ -229,7 +229,7 @@ let info_string_of_info i =
    in
    List.iter
      (fun (sref, t) ->
-       p b "\n@see %s %s"
+       p b "\n@@see %s %s"
          (escape_arobas (f_see_ref sref))
          (escape_arobas (text_string_of_text t))
      )
@@ -238,25 +238,25 @@ let info_string_of_info i =
   (
    match i.i_since with
      None -> ()
-   | Some s -> p b "\n@since %s" (escape_arobas s)
+   | Some s -> p b "\n@@since %s" (escape_arobas s)
   );
   (
    match i.i_deprecated with
      None -> ()
    | Some t ->
-       p b "\n@deprecated %s"
+       p b "\n@@deprecated %s"
          (escape_arobas (text_string_of_text t))
   );
   List.iter
     (fun (s, t) ->
-      p b "\n@param %s %s"
+      p b "\n@@param %s %s"
         (escape_arobas s)
         (escape_arobas (text_string_of_text t))
     )
     i.i_params;
   List.iter
     (fun (s, t) ->
-      p b "\n@raise %s %s"
+      p b "\n@@raise %s %s"
         (escape_arobas s)
         (escape_arobas (text_string_of_text t))
     )
@@ -265,12 +265,12 @@ let info_string_of_info i =
    match i.i_return_value with
      None -> ()
    | Some t ->
-       p b "\n@return %s"
+       p b "\n@@return %s"
          (escape_arobas (text_string_of_text t))
   );
   List.iter
     (fun (s, t) ->
-      p b "\n@%s %s" s
+      p b "\n@@%s %s" s
         (escape_arobas (text_string_of_text t))
     )
     i.i_custom;
diff --git a/otherlibs/labltk/browser/.ignore b/otherlibs/labltk/browser/.ignore
index 8ced21de22..8d7632f46b 100644
--- a/otherlibs/labltk/browser/.ignore
+++ b/otherlibs/labltk/browser/.ignore
@@ -1,2 +1,3 @@
 ocamlbrowser
 dummy.mli
+help.ml
diff --git a/otherlibs/labltk/browser/searchpos.ml b/otherlibs/labltk/browser/searchpos.ml
index 4332bedd27..f6fb50051b 100644
--- a/otherlibs/labltk/browser/searchpos.ml
+++ b/otherlibs/labltk/browser/searchpos.ml
@@ -495,7 +495,8 @@ and view_expr_type ?title ?path ?env ?(name="noname") t =
     | Some path -> parent_path path, ident_of_path path ~default:name
   in
   view_signature ~title ?path ?env
-    [Tsig_value (id, {val_type = t; val_kind = Val_reg})]
+    [Tsig_value (id, {val_type = t; val_kind = Val_reg;
+                      val_loc = Location.none})]
 
 and view_decl lid ~kind ~env =
   match kind with
diff --git a/otherlibs/win32unix/nonblock.c b/otherlibs/win32unix/nonblock.c
index 8df1048d50..1f2550b058 100755
--- a/otherlibs/win32unix/nonblock.c
+++ b/otherlibs/win32unix/nonblock.c
@@ -26,7 +26,7 @@ CAMLprim value unix_set_nonblock(socket)
     win32_maperr(WSAGetLastError());
     uerror("unix_set_nonblock", Nothing);
   }
-  Flags_fd_val(socket) = Flags_fd_val(socket) | FLAGS_FD_IS_BLOCKING;
+  Flags_fd_val(socket) = Flags_fd_val(socket) & ~FLAGS_FD_IS_BLOCKING;
   return Val_unit;
 }
 
@@ -39,6 +39,6 @@ CAMLprim value unix_clear_nonblock(socket)
     win32_maperr(WSAGetLastError());
     uerror("unix_clear_nonblock", Nothing);
   }
-  Flags_fd_val(socket) = Flags_fd_val(socket) & ~FLAGS_FD_IS_BLOCKING;
+  Flags_fd_val(socket) = Flags_fd_val(socket) | FLAGS_FD_IS_BLOCKING;
   return Val_unit;
 }
diff --git a/otherlibs/win32unix/select.c b/otherlibs/win32unix/select.c
index d96c3d9d28..af9766ff87 100644
--- a/otherlibs/win32unix/select.c
+++ b/otherlibs/win32unix/select.c
@@ -556,7 +556,7 @@ void socket_poll (HANDLE hStop, void *_data)
       if (iterQuery->uFlagsFd & FLAGS_FD_IS_BLOCKING)
       {
         DEBUG_PRINT("Restore a blocking socket");
-        iMode = 1;
+        iMode = 0;
         check_error(lpSelectData,
           WSAEventSelect((SOCKET)(iterQuery->hFileDescr), aEvents[i], 0) != 0 ||
           ioctlsocket((SOCKET)(iterQuery->hFileDescr), FIONBIO, &iMode) != 0);
diff --git a/otherlibs/win32unix/unixsupport.c b/otherlibs/win32unix/unixsupport.c
index 2a45684a69..f6431955bf 100644
--- a/otherlibs/win32unix/unixsupport.c
+++ b/otherlibs/win32unix/unixsupport.c
@@ -54,7 +54,7 @@ value win_alloc_handle(HANDLE h)
   Handle_val(res) = h;
   Descr_kind_val(res) = KIND_HANDLE;
   CRT_fd_val(res) = NO_CRT_FD;
-  Flags_fd_val(res) = 0;
+  Flags_fd_val(res) = FLAGS_FD_IS_BLOCKING;
   return res;
 }
 
@@ -64,7 +64,7 @@ value win_alloc_socket(SOCKET s)
   Socket_val(res) = s;
   Descr_kind_val(res) = KIND_SOCKET;
   CRT_fd_val(res) = NO_CRT_FD;
-  Flags_fd_val(res) = 0;
+  Flags_fd_val(res) = FLAGS_FD_IS_BLOCKING;
   return res;
 }
 
diff --git a/parsing/lexer.mll b/parsing/lexer.mll
index 20af0fb313..87e2a8cbce 100644
--- a/parsing/lexer.mll
+++ b/parsing/lexer.mll
@@ -416,7 +416,7 @@ and comment = parse
   | "*)"
       { match !comment_start_loc with
         | [] -> assert false
-        | [x] -> comment_start_loc := [];
+        | [_] -> comment_start_loc := [];
         | _ :: l -> comment_start_loc := l;
                     comment lexbuf;
        }
diff --git a/parsing/location.ml b/parsing/location.ml
index e4c09aa3ae..dd6d08fb12 100644
--- a/parsing/location.ml
+++ b/parsing/location.ml
@@ -207,7 +207,7 @@ let get_pos_info pos =
   (pos.pos_fname, pos.pos_lnum, pos.pos_cnum - pos.pos_bol)
 ;;
 
-let print ppf loc =
+let print_loc ppf loc =
   let (file, line, startchar) = get_pos_info loc.loc_start in
   let endchar = loc.loc_end.pos_cnum - loc.loc_start.pos_cnum + startchar in
   if file = "//toplevel//" then begin
@@ -217,11 +217,15 @@ let print ppf loc =
   end else begin
     fprintf ppf "%s%s%s%i" msg_file file msg_line line;
     if startchar >= 0 then
-      fprintf ppf "%s%i%s%i" msg_chars startchar msg_to endchar;
-    fprintf ppf "%s@.%s" msg_colon msg_head;
+      fprintf ppf "%s%i%s%i" msg_chars startchar msg_to endchar
   end
 ;;
 
+let print ppf loc =
+  if loc.loc_start.pos_fname = "//toplevel//"
+  && highlight_locations ppf loc none then ()
+  else fprintf ppf "%a%s@.%s" print_loc loc msg_colon msg_head
+
 let print_error ppf loc =
   print ppf loc;
   fprintf ppf "Error: ";
@@ -235,7 +239,7 @@ let print_warning loc ppf w =
       let n = Warnings.print ppf w in
       num_loc_lines := !num_loc_lines + n
     in
-    fprintf ppf "%a" print loc;
+    print ppf loc;
     fprintf ppf "Warning %a@." printw w;
     pp_print_flush ppf ();
     incr num_loc_lines;
diff --git a/parsing/location.mli b/parsing/location.mli
index 2215d98646..d984c8423f 100644
--- a/parsing/location.mli
+++ b/parsing/location.mli
@@ -46,7 +46,8 @@ val rhs_loc: int -> t
 val input_name: string ref
 val input_lexbuf: Lexing.lexbuf option ref
 
-val get_pos_info : Lexing.position -> string * int * int (* file, line, char *)
+val get_pos_info: Lexing.position -> string * int * int (* file, line, char *)
+val print_loc: formatter -> t -> unit
 val print_error: formatter -> t -> unit
 val print_error_cur_file: formatter -> unit
 val print_warning: t -> formatter -> Warnings.t -> unit
@@ -55,3 +56,5 @@ val echo_eof: unit -> unit
 val reset: unit -> unit
 
 val highlight_locations: formatter -> t -> t -> bool
+
+val print: formatter -> t -> unit
diff --git a/parsing/longident.ml b/parsing/longident.ml
index 1114a2ef55..612f9df197 100644
--- a/parsing/longident.ml
+++ b/parsing/longident.ml
@@ -20,14 +20,14 @@ type t =
 let rec flat accu = function
     Lident s -> s :: accu
   | Ldot(lid, s) -> flat (s :: accu) lid
-  | Lapply(l1, l2) -> Misc.fatal_error "Longident.flat"
+  | Lapply(_, _) -> Misc.fatal_error "Longident.flat"
 
 let flatten lid = flat [] lid
 
 let last = function
     Lident s -> s
-  | Ldot(lid, s) -> s
-  | Lapply(l1, l2) -> Misc.fatal_error "Longident.last"
+  | Ldot(_, s) -> s
+  | Lapply(_, _) -> Misc.fatal_error "Longident.last"
 
 let rec split_at_dots s pos =
   try
diff --git a/parsing/parser.mly b/parsing/parser.mly
index 2c0b3bddc3..e3b94667f3 100644
--- a/parsing/parser.mly
+++ b/parsing/parser.mly
@@ -70,8 +70,9 @@ let ghtyp d = { ptyp_desc = d; ptyp_loc = symbol_gloc () };;
 
 let mkassert e =
   match e with
-  | {pexp_desc = Pexp_construct (Lident "false", None, false) } ->
-         mkexp (Pexp_assertfalse)
+  | { pexp_desc = Pexp_construct (Lident "false", None, false);
+      pexp_loc = _ } ->
+      mkexp (Pexp_assertfalse)
   | _ -> mkexp (Pexp_assert (e))
 ;;
 
@@ -93,7 +94,7 @@ let mkuminus name arg =
       mkexp(Pexp_constant(Const_int64(Int64.neg n)))
   | "-", Pexp_constant(Const_nativeint n) ->
       mkexp(Pexp_constant(Const_nativeint(Nativeint.neg n)))
-  | ("-" | "-."), Pexp_constant(Const_float f) ->
+  | _, Pexp_constant(Const_float f) ->
       mkexp(Pexp_constant(Const_float(neg_float_string f)))
   | _ ->
       mkexp(Pexp_apply(mkoperator ("~" ^ name) 1, ["", arg]))
@@ -160,7 +161,7 @@ let bigarray_function str name =
   Ldot(Ldot(Lident "Bigarray", str), name)
 
 let bigarray_untuplify = function
-    { pexp_desc = Pexp_tuple explist} -> explist
+    { pexp_desc = Pexp_tuple explist; pexp_loc = _ } -> explist
   | exp -> [exp]
 
 let bigarray_get arr arg =
@@ -593,7 +594,7 @@ structure_tail:
 structure_item:
     LET rec_flag let_bindings
       { match $3 with
-          [{ppat_desc = Ppat_any}, exp] -> mkstr(Pstr_eval exp)
+          [{ ppat_desc = Ppat_any; ppat_loc = _ }, exp] -> mkstr(Pstr_eval exp)
         | _ -> mkstr(Pstr_value($2, List.rev $3)) }
   | EXTERNAL val_ident COLON core_type EQUAL primitive_declaration
       { mkstr(Pstr_primitive($2, {pval_type = $4; pval_prim = $6})) }
@@ -1379,7 +1380,7 @@ type_declaration:
               ptype_private = private_flag;
               ptype_manifest = manifest;
               ptype_variance = variance;
-              ptype_loc = symbol_rloc()}) }
+              ptype_loc = symbol_rloc() }) }
 ;
 constraints:
         constraints CONSTRAINT constrain        { $3 :: $1 }
diff --git a/parsing/parsetree.mli b/parsing/parsetree.mli
index 84ee659c01..b8d7da9fc0 100644
--- a/parsing/parsetree.mli
+++ b/parsing/parsetree.mli
@@ -189,12 +189,14 @@ and class_structure = pattern * class_field list
 and class_field =
     Pcf_inher of override_flag * class_expr * string option
   | Pcf_valvirt of (string * mutable_flag * core_type * Location.t)
-  | Pcf_val of (string * mutable_flag * override_flag * expression * Location.t)
-  | Pcf_virt  of (string * private_flag * core_type * Location.t)
-  | 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
+  | Pcf_val of
+      (string * mutable_flag * override_flag * expression * Location.t)
+  | Pcf_virt of (string * private_flag * core_type * Location.t)
+  | 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
 
@@ -239,7 +241,7 @@ and with_constraint =
   | Pwith_typesubst of type_declaration
   | Pwith_modsubst of Longident.t
 
-(* value expressions for the module language *)
+(* Value expressions for the module language *)
 
 and module_expr =
   { pmod_desc: module_expr_desc;
diff --git a/parsing/printast.ml b/parsing/printast.ml
index 713295f6fa..6329f53020 100644
--- a/parsing/printast.ml
+++ b/parsing/printast.ml
@@ -96,7 +96,7 @@ let line i f s (*...*) =
 let list i f ppf l =
   match l with
   | [] -> line i ppf "[]\n";
-  | h::t ->
+  | _ :: _ ->
      line i ppf "[\n";
      List.iter (f (i+1) ppf) l;
      line i ppf "]\n";
@@ -152,7 +152,7 @@ let rec core_type i ppf x =
       core_type i ppf ct;
   | Ptyp_package (s, l) ->
       line i ppf "Ptyp_package %a\n" fmt_longident s;
-      list i package_with ppf l
+      list i package_with ppf l;
 
 and package_with i ppf (s, t) =
   line i ppf "with type %s\n" s;
@@ -524,7 +524,7 @@ and module_type i ppf x =
       list i longident_x_with_constraint ppf l;
   | Pmty_typeof m ->
       line i ppf "Pmty_typeof\n";
-      module_expr i ppf m
+      module_expr i ppf m;
 
 and signature i ppf x = list i signature_item ppf x
 
diff --git a/parsing/syntaxerr.ml b/parsing/syntaxerr.ml
index b0fda3695b..29f0deb3aa 100644
--- a/parsing/syntaxerr.ml
+++ b/parsing/syntaxerr.ml
@@ -37,7 +37,9 @@ let report_error ppf = function
           Location.print_error opening_loc opening
       end
   | Applicative_path loc ->
-      fprintf ppf "%aSyntax error: applicative paths of the form F(X).t are not supported when the option -no-app-func is set."
+      fprintf ppf
+        "%aSyntax error: applicative paths of the form F(X).t \
+         are not supported when the option -no-app-func is set."
         Location.print_error loc
   | Other loc ->
       fprintf ppf "%aSyntax error" Location.print_error loc
diff --git a/stdlib/Compflags b/stdlib/Compflags
index 6ab038f44b..80bb1b6673 100755
--- a/stdlib/Compflags
+++ b/stdlib/Compflags
@@ -18,7 +18,7 @@ case $1 in
   pervasives.cm[iox]|pervasives.p.cmx) echo ' -nopervasives';;
   camlinternalOO.cmi) echo ' -nopervasives';;
   camlinternalOO.cmx|camlinternalOO.p.cmx) echo ' -inline 0';;
-  printf.cm[io]|format.cm[io]|scanf.cm[io]) echo ' -w A';;
+  buffer.cm[io]|printf.cm[io]|format.cm[io]|scanf.cm[io]) echo ' -w A';;
   scanf.cmx|scanf.p.cmx) echo ' -inline 9';;
   arrayLabels.cm[ox]|arrayLabels.p.cmx) echo ' -nolabels';;
   listLabels.cm[ox]|listLabels.p.cmx) echo ' -nolabels';;
diff --git a/stdlib/format.ml b/stdlib/format.ml
index 9cb9a1afd3..28bb5f1c59 100644
--- a/stdlib/format.ml
+++ b/stdlib/format.ml
@@ -1148,7 +1148,7 @@ let mkprintf to_s get_out =
               print_as := Some size;
               doprn n (skip_gt i) in
             get_int n (succ i) got_size
-          | '@' as c ->
+          | '@' | '%' as c ->
             pp_print_as_char c;
             doprn n (succ i)
           | _ -> invalid_format fmt i
diff --git a/stdlib/format.mli b/stdlib/format.mli
index 8ddc0f5194..5a55a1547d 100644
--- a/stdlib/format.mli
+++ b/stdlib/format.mli
@@ -617,7 +617,7 @@ val fprintf : formatter -> ('a, formatter, unit) format -> 'a;;
    - [@.]: flush the pretty printer and output a new line, as with
      [print_newline ()].
    - [@<n>]: print the following item as if it were of length [n].
-     Hence, [printf "@<0>%s" arg] is equivalent to [print_as 0 arg].
+     Hence, [printf "@<0>%s" arg] prints [arg] as a zero length string.
      If [@<n>] is not followed by a conversion specification,
      then the following character of the format is printed as if
      it were of length [n].
@@ -632,6 +632,7 @@ val fprintf : formatter -> ('a, formatter, unit) format -> 'a;;
      [close_tag].
    - [@\}]: close the most recently opened tag.
    - [@@]: print a plain [@] character.
+   - [@%]: print a plain [%] character.
 
    Example: [printf "@[%s@ %d@]@." "x =" 1] is equivalent to
    [open_box (); print_string "x ="; print_space ();
diff --git a/stdlib/marshal.mli b/stdlib/marshal.mli
index 800f061e3c..90e6dbffe1 100644
--- a/stdlib/marshal.mli
+++ b/stdlib/marshal.mli
@@ -115,7 +115,7 @@ val header_size : int
    {!Marshal.data_size}[ buff ofs] is the size, in characters,
    of the data part, assuming a valid header is stored in
    [buff] starting at position [ofs].
-   Finally, {!Marshal.total_size}[ buff ofs] is the total size,
+   Finally, {!Marshal.total_size} [buff ofs] is the total size,
    in characters, of the marshaled value.
    Both {!Marshal.data_size} and {!Marshal.total_size} raise [Failure]
    if [buff], [ofs] does not contain a valid header.
diff --git a/stdlib/pervasives.mli b/stdlib/pervasives.mli
index e5b21d1106..d2141cd74a 100644
--- a/stdlib/pervasives.mli
+++ b/stdlib/pervasives.mli
@@ -905,7 +905,7 @@ val exit : int -> 'a
 (** Terminate the process, returning the given status code
    to the operating system: usually 0 to indicate no errors,
    and a small positive integer to indicate failure.
-   All open output channels are flushed with flush_all.
+   All open output channels are flushed with [flush_all].
    An implicit [exit 0] is performed each time a program
    terminates normally.  An implicit [exit 2] is performed if the program
    terminates early because of an uncaught exception. *)
diff --git a/stdlib/scanf.ml b/stdlib/scanf.ml
index a11613c203..ee80f5e7a6 100644
--- a/stdlib/scanf.ml
+++ b/stdlib/scanf.ml
@@ -214,16 +214,16 @@ module Scanning : SCANNING = struct
 
   let token_count ib = ib.token_count;;
 
-  let skip_char max ib =
+  let skip_char width ib =
     invalidate_current_char ib;
-    max
+    width
   ;;
 
-  let ignore_char max ib = skip_char (max - 1) ib;;
+  let ignore_char width ib = skip_char (width - 1) ib;;
 
-  let store_char max ib c =
+  let store_char width ib c =
     Buffer.add_char ib.tokbuf c;
-    ignore_char max ib
+    ignore_char width ib
   ;;
 
   let default_token_buffer_size = 1024;;
@@ -432,19 +432,14 @@ let bad_end_of_input message =
         premature end of file occurred before end of token" message)
 ;;
 
-let int_max = function
+let int_of_width_opt = function
   | None -> max_int
-  | Some max -> max
+  | Some width -> width
 ;;
 
-let int_min = function
+let int_of_prec_opt = function
   | None -> 0
-  | Some max -> max
-;;
-
-let float_min = function
-  | None -> max_int
-  | Some min -> min
+  | Some prec -> prec
 ;;
 
 module Sformat = Printf.CamlinternalPr.Sformat;;
@@ -593,55 +588,55 @@ let token_int64 conv ib = int64_of_string (token_int_literal conv ib);;
    available before calling one of the digit scanning functions). *)
 
 (* The decimal case is treated especially for optimization purposes. *)
-let rec scan_decimal_digits max ib =
-  if max = 0 then max else
+let rec scan_decimal_digits width ib =
+  if width = 0 then width else
   let c = Scanning.peek_char ib in
-  if Scanning.eof ib then max else
+  if Scanning.eof ib then width else
   match c with
   | '0' .. '9' as c ->
-    let max = Scanning.store_char max ib c in
-    scan_decimal_digits max ib
+    let width = Scanning.store_char width ib c in
+    scan_decimal_digits width ib
   | '_' ->
-    let max = Scanning.ignore_char max ib in
-    scan_decimal_digits max ib
-  | _ -> max
+    let width = Scanning.ignore_char width ib in
+    scan_decimal_digits width ib
+  | _ -> width
 ;;
 
-let scan_decimal_digits_plus max ib =
-  if max = 0 then bad_token_length "decimal digits" else
+let scan_decimal_digits_plus width ib =
+  if width = 0 then bad_token_length "decimal digits" else
   let c = Scanning.checked_peek_char ib in
   match c with
   | '0' .. '9' ->
-    let max = Scanning.store_char max ib c in
-    scan_decimal_digits max ib
+    let width = Scanning.store_char width ib c in
+    scan_decimal_digits width ib
   | c ->
     bad_input (Printf.sprintf "character %C is not a decimal digit" c)
 ;;
 
-let scan_digits_plus digitp max ib =
+let scan_digits_plus digitp width ib =
   (* To scan numbers from other bases, we use a predicate argument to
      scan_digits. *)
-  let rec scan_digits max =
-    if max = 0 then max else
+  let rec scan_digits width =
+    if width = 0 then width else
     let c = Scanning.peek_char ib in
-    if Scanning.eof ib then max else
+    if Scanning.eof ib then width else
     match c with
     | c when digitp c ->
-      let max = Scanning.store_char max ib c in
-      scan_digits max
+      let width = Scanning.store_char width ib c in
+      scan_digits width
     | '_' ->
-      let max = Scanning.ignore_char max ib in
-      scan_digits max
-    | _ -> max in
+      let width = Scanning.ignore_char width ib in
+      scan_digits width
+    | _ -> width in
 
   (* Ensure we have got enough width left,
      and read at list one digit. *)
-  if max = 0 then bad_token_length "digits" else
+  if width = 0 then bad_token_length "digits" else
   let c = Scanning.checked_peek_char ib in
 
   if digitp c then
-    let max = Scanning.store_char max ib c in
-    scan_digits max
+    let width = Scanning.store_char width ib c in
+    scan_digits width
   else
     bad_input (Printf.sprintf "character %C is not a digit" c)
 ;;
@@ -670,144 +665,146 @@ let scan_hexadecimal_int = scan_digits_plus is_hexa_digit;;
 (* Scan a decimal integer. *)
 let scan_unsigned_decimal_int = scan_decimal_digits_plus;;
 
-let scan_sign max ib =
+let scan_sign width ib =
   let c = Scanning.checked_peek_char ib in
   match c with
-  | '+' -> Scanning.store_char max ib c
-  | '-' -> Scanning.store_char max ib c
-  | _ -> max
+  | '+' -> Scanning.store_char width ib c
+  | '-' -> Scanning.store_char width ib c
+  | _ -> width
 ;;
 
-let scan_optionally_signed_decimal_int max ib =
-  let max = scan_sign max ib in
-  scan_unsigned_decimal_int max ib
+let scan_optionally_signed_decimal_int width ib =
+  let width = scan_sign width ib in
+  scan_unsigned_decimal_int width ib
 ;;
 
 (* Scan an unsigned integer that could be given in any (common) basis.
    If digits are prefixed by one of 0x, 0X, 0o, or 0b, the number is
    assumed to be written respectively in hexadecimal, hexadecimal,
    octal, or binary. *)
-let scan_unsigned_int max ib =
+let scan_unsigned_int width ib =
   match Scanning.checked_peek_char ib with
   | '0' as c ->
-    let max = Scanning.store_char max ib c in
-    if max = 0 then max else
+    let width = Scanning.store_char width ib c in
+    if width = 0 then width else
     let c = Scanning.peek_char ib in
-    if Scanning.eof ib then max else
+    if Scanning.eof ib then width else
     begin match c with
-    | 'x' | 'X' -> scan_hexadecimal_int (Scanning.store_char max ib c) ib
-    | 'o' -> scan_octal_int (Scanning.store_char max ib c) ib
-    | 'b' -> scan_binary_int (Scanning.store_char max ib c) ib
-    | _ -> scan_decimal_digits max ib end
-  | _ -> scan_unsigned_decimal_int max ib
+    | 'x' | 'X' -> scan_hexadecimal_int (Scanning.store_char width ib c) ib
+    | 'o' -> scan_octal_int (Scanning.store_char width ib c) ib
+    | 'b' -> scan_binary_int (Scanning.store_char width ib c) ib
+    | _ -> scan_decimal_digits width ib end
+  | _ -> scan_unsigned_decimal_int width ib
 ;;
 
-let scan_optionally_signed_int max ib =
-  let max = scan_sign max ib in
-  scan_unsigned_int max ib
+let scan_optionally_signed_int width ib =
+  let width = scan_sign width ib in
+  scan_unsigned_int width ib
 ;;
 
-let scan_int_conv conv max _min ib =
+let scan_int_conv conv width _prec ib =
   match conv with
-  | 'b' -> scan_binary_int max ib
-  | 'd' -> scan_optionally_signed_decimal_int max ib
-  | 'i' -> scan_optionally_signed_int max ib
-  | 'o' -> scan_octal_int max ib
-  | 'u' -> scan_unsigned_decimal_int max ib
-  | 'x' | 'X' -> scan_hexadecimal_int max ib
+  | 'b' -> scan_binary_int width ib
+  | 'd' -> scan_optionally_signed_decimal_int width ib
+  | 'i' -> scan_optionally_signed_int width ib
+  | 'o' -> scan_octal_int width ib
+  | 'u' -> scan_unsigned_decimal_int width ib
+  | 'x' | 'X' -> scan_hexadecimal_int width ib
   | _ -> assert false
 ;;
 
 (* Scanning floating point numbers. *)
 (* Fractional part is optional and can be reduced to 0 digits. *)
-let scan_frac_part max ib =
-  if max = 0 then max else
+let scan_frac_part width ib =
+  if width = 0 then width else
   let c = Scanning.peek_char ib in
-  if Scanning.eof ib then max else
+  if Scanning.eof ib then width else
   match c with
   | '0' .. '9' as c ->
-    scan_decimal_digits (Scanning.store_char max ib c) ib
-  | _ -> max
+    scan_decimal_digits (Scanning.store_char width ib c) ib
+  | _ -> width
 ;;
 
 (* Exp part is optional and can be reduced to 0 digits. *)
-let scan_exp_part max ib =
-  if max = 0 then max else
+let scan_exp_part width ib =
+  if width = 0 then width else
   let c = Scanning.peek_char ib in
-  if Scanning.eof ib then max else
+  if Scanning.eof ib then width else
   match c with
   | 'e' | 'E' as c ->
-    scan_optionally_signed_decimal_int (Scanning.store_char max ib c) ib
-  | _ -> max
+    scan_optionally_signed_decimal_int (Scanning.store_char width ib c) ib
+  | _ -> width
 ;;
 
 (* Scan the integer part of a floating point number, (not using the
    Caml 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 max ib =
-  let max = scan_sign max ib in
-  scan_decimal_digits max ib
+let scan_int_part width ib =
+  let width = scan_sign width ib in
+  scan_decimal_digits width ib
 ;;
 
 (*
-    For the time being we have (as found in scanf.mli):
-    The field width is composed of an optional integer literal
-    indicating the maximal width of the token to read.
-    Unfortunately, the type-checker let the user write an optional precision,
-    since this is valid for printf format strings.
+   For the time being we have (as found in scanf.mli):
+   The field width is composed of an optional integer literal
+   indicating the maximal width of the token to read.
+   Unfortunately, the type-checker let the user write an optional precision,
+   since this is valid for printf format strings.
 
-   Thus, the next step for Scanf is to support a full width indication, more
-   or less similar to the one for printf, possibly extended to the
-   specification of a [max, min] range for the width of the token read for
-   strings. Something like the following spec for scanf.mli:
+   Thus, the next step for Scanf is to support a full width and precision
+   indication, more or less similar to the one for printf, possibly extended
+   to the specification of a [max, min] range for the width of the token read
+   for strings. Something like the following spec for scanf.mli:
 
    The optional [width] is an integer indicating the maximal
    width of the token read. For instance, [%6d] reads an integer,
    having at most 6 characters.
 
    The optional [precision] is a dot [.] followed by an integer:
-   - in the floating point number conversions ([%f], [%e], [%g], [%F], [%E], and
-   [%F] conversions, the [precision] indicates the maximum number of digits
-   that may follow the decimal point. For instance, [%.4f] reads a [float]
-   with at most 4 fractional digits,
+
+   - in the floating point number conversions ([%f], [%e], [%g], [%F], [%E],
+   and [%F] conversions, the [precision] indicates the maximum number of
+   digits that may follow the decimal point. For instance, [%.4f] reads a
+   [float] with at most 4 fractional digits,
+
    - in the string conversions ([%s], [%S], [%\[ range \]]), and in the
    integer number conversions ([%i], [%d], [%u], [%x], [%o], and their
-   [int32], [int64], and [native_int] correspondent), the
-   [precision] indicates the required minimum width of the token read,
+   [int32], [int64], and [native_int] correspondent), the [precision]
+   indicates the required minimum width of the token read,
+
    - on all other conversions, the width and precision are meaningless and
    ignored (FIXME: lead to a runtime error ? type checking error ?).
-
 *)
-let scan_float max max_frac_part ib =
-  let max = scan_int_part max ib in
-  if max = 0 then max, max_frac_part else
+
+let scan_float width precision ib =
+  let width = scan_int_part width ib in
+  if width = 0 then width, precision else
   let c = Scanning.peek_char ib in
-  if Scanning.eof ib then max, max_frac_part else
+  if Scanning.eof ib then width, precision else
   match c with
   | '.' ->
-    let max = Scanning.store_char max ib c in
-    let max_precision = min max max_frac_part in
-    let max = max - (max_precision - scan_frac_part max_precision ib) in
-    scan_exp_part max ib, max_frac_part
+    let width = Scanning.store_char width ib c in
+    let precision = min width precision in
+    let width = width - (precision - scan_frac_part precision ib) in
+    scan_exp_part width ib, precision
   | _ ->
-    scan_exp_part max ib, max_frac_part
+    scan_exp_part width ib, precision
 ;;
 
-let scan_Float max max_frac_part ib =
-  let max = scan_optionally_signed_decimal_int max ib in
-  if max = 0 then bad_float () else
+let scan_Float width precision ib =
+  let width = scan_optionally_signed_decimal_int width ib in
+  if width = 0 then bad_float () else
   let c = Scanning.peek_char ib in
   if Scanning.eof ib then bad_float () else
   match c with
   | '.' ->
-    let max = Scanning.store_char max ib c in
-    let max_precision = min max max_frac_part in
-    let max = max - (max_precision - scan_frac_part max_precision ib) in
-    let max = scan_frac_part max ib in
-    scan_exp_part max ib
+    let width = Scanning.store_char width ib c in
+    let precision = min width precision in
+    let width = width - (precision - scan_frac_part precision ib) in
+    scan_exp_part width ib
   | 'e' | 'E' ->
-    scan_exp_part max ib
+    scan_exp_part width ib
   | _ -> bad_float ()
 ;;
 
@@ -817,26 +814,26 @@ let scan_Float max max_frac_part ib =
    indication list [stp].
    It also stops at end of file or when the maximum number of characters has
    been read.*)
-let scan_string stp max ib =
-  let rec loop max =
-    if max = 0 then max else
+let scan_string stp width ib =
+  let rec loop width =
+    if width = 0 then width else
     let c = Scanning.peek_char ib in
-    if Scanning.eof ib then max else
+    if Scanning.eof ib then width else
     if stp = [] then
       match c with
-      | ' ' | '\t' | '\n' | '\r' -> max
-      | c -> loop (Scanning.store_char max ib c) else
-    if List.memq c stp then Scanning.skip_char max ib else
-    loop (Scanning.store_char max ib c) in
-  loop max
+      | ' ' | '\t' | '\n' | '\r' -> width
+      | c -> loop (Scanning.store_char width ib c) else
+    if List.memq c stp then Scanning.skip_char width ib else
+    loop (Scanning.store_char width ib c) in
+  loop width
 ;;
 
 (* Scan a char: peek strictly one character in the input, whatsoever. *)
-let scan_char max ib =
-  (* The case max = 0 could not happen here, since it is tested before
+let scan_char width ib =
+  (* The case width = 0 could not happen here, since it is tested before
      calling scan_char, in the main scanning function.
-    if max = 0 then bad_token_length "a character" else *)
-  Scanning.store_char max ib (Scanning.checked_peek_char ib)
+    if width = 0 then bad_token_length "a character" else *)
+  Scanning.store_char width ib (Scanning.checked_peek_char ib)
 ;;
 
 let char_for_backslash = function
@@ -891,8 +888,8 @@ let char_for_hexadecimal_code c1 c2 =
 
 (* Called in particular when encountering '\\' as starter of a char.
    Stops before the corresponding '\''. *)
-let check_next_char message max ib =
-  if max = 0 then bad_token_length message else
+let check_next_char message width ib =
+  if width = 0 then bad_token_length message else
   let c = Scanning.peek_char ib in
   if Scanning.eof ib then bad_end_of_input message else
   c
@@ -901,10 +898,10 @@ let check_next_char message max ib =
 let check_next_char_for_char = check_next_char "a Char";;
 let check_next_char_for_string = check_next_char "a String";;
 
-let scan_backslash_char max ib =
-  match check_next_char_for_char max ib with
+let scan_backslash_char width ib =
+  match check_next_char_for_char width ib with
   | '\\' | '\'' | '\"' | 'n' | 't' | 'b' | 'r' as c ->
-    Scanning.store_char max ib (char_for_backslash c)
+    Scanning.store_char width ib (char_for_backslash c)
   | '0' .. '9' as c ->
     let get_digit () =
       let c = Scanning.next_char ib in
@@ -914,7 +911,7 @@ let scan_backslash_char max ib =
     let c0 = c in
     let c1 = get_digit () in
     let c2 = get_digit () in
-    Scanning.store_char (max - 2) ib (char_for_decimal_code c0 c1 c2)
+    Scanning.store_char (width - 2) ib (char_for_decimal_code c0 c1 c2)
   | 'x' ->
     let get_digit () =
       let c = Scanning.next_char ib in
@@ -923,68 +920,68 @@ let scan_backslash_char max ib =
       | c -> bad_input_escape c in
     let c1 = get_digit () in
     let c2 = get_digit () in
-    Scanning.store_char (max - 2) ib (char_for_hexadecimal_code c1 c2)
+    Scanning.store_char (width - 2) ib (char_for_hexadecimal_code c1 c2)
   | c ->
     bad_input_escape c
 ;;
 
 (* Scan a character (a Caml token). *)
-let scan_Char max ib =
+let scan_Char width ib =
 
-  let rec find_start max =
+  let rec find_start width =
     match Scanning.checked_peek_char ib with
-    | '\'' -> find_char (Scanning.ignore_char max ib)
+    | '\'' -> find_char (Scanning.ignore_char width ib)
     | c -> character_mismatch '\'' c
 
-  and find_char max =
-    match check_next_char_for_char max ib with
-    | '\\' -> find_stop (scan_backslash_char (Scanning.ignore_char max ib) ib)
-    | c -> find_stop (Scanning.store_char max ib c)
+  and find_char width =
+    match check_next_char_for_char width ib with
+    | '\\' -> find_stop (scan_backslash_char (Scanning.ignore_char width ib) ib)
+    | c -> find_stop (Scanning.store_char width ib c)
 
-  and find_stop max =
-    match check_next_char_for_char max ib with
-    | '\'' -> Scanning.ignore_char max ib
+  and find_stop width =
+    match check_next_char_for_char width ib with
+    | '\'' -> Scanning.ignore_char width ib
     | c -> character_mismatch '\'' c in
 
-  find_start max
+  find_start width
 ;;
 
 (* Scan a delimited string (a Caml token). *)
-let scan_String max ib =
+let scan_String width ib =
 
-  let rec find_start max =
+  let rec find_start width =
     match Scanning.checked_peek_char ib with
-    | '\"' -> find_stop (Scanning.ignore_char max ib)
+    | '\"' -> find_stop (Scanning.ignore_char width ib)
     | c -> character_mismatch '\"' c
 
-  and find_stop max =
-    match check_next_char_for_string max ib with
-    | '\"' -> Scanning.ignore_char max ib
-    | '\\' -> scan_backslash (Scanning.ignore_char max ib)
-    | c -> find_stop (Scanning.store_char max ib c)
+  and find_stop width =
+    match check_next_char_for_string width ib with
+    | '\"' -> Scanning.ignore_char width ib
+    | '\\' -> scan_backslash (Scanning.ignore_char width ib)
+    | c -> find_stop (Scanning.store_char width ib c)
 
-  and scan_backslash max =
-    match check_next_char_for_string max ib with
-    | '\r' -> skip_newline (Scanning.ignore_char max ib)
-    | '\n' -> skip_spaces (Scanning.ignore_char max ib)
-    | _ -> find_stop (scan_backslash_char max ib)
+  and scan_backslash width =
+    match check_next_char_for_string width ib with
+    | '\r' -> skip_newline (Scanning.ignore_char width ib)
+    | '\n' -> skip_spaces (Scanning.ignore_char width ib)
+    | _ -> find_stop (scan_backslash_char width ib)
 
-  and skip_newline max =
-    match check_next_char_for_string max ib with
-    | '\n' -> skip_spaces (Scanning.ignore_char max ib)
-    | _ -> find_stop (Scanning.store_char max ib '\r')
+  and skip_newline width =
+    match check_next_char_for_string width ib with
+    | '\n' -> skip_spaces (Scanning.ignore_char width ib)
+    | _ -> find_stop (Scanning.store_char width ib '\r')
 
-  and skip_spaces max =
-    match check_next_char_for_string max ib with
-    | ' ' -> skip_spaces (Scanning.ignore_char max ib)
-    | _ -> find_stop max in
+  and skip_spaces width =
+    match check_next_char_for_string width ib with
+    | ' ' -> skip_spaces (Scanning.ignore_char width ib)
+    | _ -> find_stop width in
 
-  find_start max
+  find_start width
 ;;
 
 (* Scan a boolean (a Caml token). *)
-let scan_bool max ib =
-  if max < 4 then bad_token_length "a boolean" else
+let scan_bool width ib =
+  if width < 4 then bad_token_length "a boolean" else
   let c = Scanning.checked_peek_char ib in
   let m =
     match c with
@@ -993,7 +990,7 @@ let scan_bool max ib =
     | c ->
       bad_input
         (Printf.sprintf "the character %C cannot start a boolean" c) in
-  scan_string [] (min max m) ib
+  scan_string [] (min width m) ib
 ;;
 
 (* Reading char sets in %[...] conversions. *)
@@ -1155,75 +1152,75 @@ let find_setp stp char_set =
     setp
 ;;
 
-let scan_chars_in_char_set stp char_set max ib =
-  let rec loop_pos1 cp1 max =
-    if max = 0 then max else
+let scan_chars_in_char_set stp char_set width ib =
+  let rec loop_pos1 cp1 width =
+    if width = 0 then width else
     let c = Scanning.peek_char ib in
-    if Scanning.eof ib then max else
+    if Scanning.eof ib then width else
     if c == cp1
-    then loop_pos1 cp1 (Scanning.store_char max ib c)
-    else max
-  and loop_pos2 cp1 cp2 max =
-    if max = 0 then max else
+    then loop_pos1 cp1 (Scanning.store_char width ib c)
+    else width
+  and loop_pos2 cp1 cp2 width =
+    if width = 0 then width else
     let c = Scanning.peek_char ib in
-    if Scanning.eof ib then max else
+    if Scanning.eof ib then width else
     if c == cp1 || c == cp2
-    then loop_pos2 cp1 cp2 (Scanning.store_char max ib c)
-    else max
-  and loop_pos3 cp1 cp2 cp3 max =
-    if max = 0 then max else
+    then loop_pos2 cp1 cp2 (Scanning.store_char width ib c)
+    else width
+  and loop_pos3 cp1 cp2 cp3 width =
+    if width = 0 then width else
     let c = Scanning.peek_char ib in
-    if Scanning.eof ib then max else
+    if Scanning.eof ib then width else
     if c == cp1 || c == cp2 || c == cp3
-    then loop_pos3 cp1 cp2 cp3 (Scanning.store_char max ib c)
-    else max
-  and loop_neg1 cp1 max =
-    if max = 0 then max else
+    then loop_pos3 cp1 cp2 cp3 (Scanning.store_char width ib c)
+    else width
+  and loop_neg1 cp1 width =
+    if width = 0 then width else
     let c = Scanning.peek_char ib in
-    if Scanning.eof ib then max else
+    if Scanning.eof ib then width else
     if c != cp1
-    then loop_neg1 cp1 (Scanning.store_char max ib c)
-    else max
-  and loop_neg2 cp1 cp2 max =
-    if max = 0 then max else
+    then loop_neg1 cp1 (Scanning.store_char width ib c)
+    else width
+  and loop_neg2 cp1 cp2 width =
+    if width = 0 then width else
     let c = Scanning.peek_char ib in
-    if Scanning.eof ib then max else
+    if Scanning.eof ib then width else
     if c != cp1 && c != cp2
-    then loop_neg2 cp1 cp2 (Scanning.store_char max ib c)
-    else max
-  and loop_neg3 cp1 cp2 cp3 max =
-    if max = 0 then max else
+    then loop_neg2 cp1 cp2 (Scanning.store_char width ib c)
+    else width
+  and loop_neg3 cp1 cp2 cp3 width =
+    if width = 0 then width else
     let c = Scanning.peek_char ib in
-    if Scanning.eof ib then max else
+    if Scanning.eof ib then width else
     if c != cp1 && c != cp2 && c != cp3
-    then loop_neg3 cp1 cp2 cp3 (Scanning.store_char max ib c)
-    else max
-  and loop setp max =
-    if max = 0 then max else
+    then loop_neg3 cp1 cp2 cp3 (Scanning.store_char width ib c)
+    else width
+  and loop setp width =
+    if width = 0 then width else
     let c = Scanning.peek_char ib in
-    if Scanning.eof ib then max else
+    if Scanning.eof ib then width else
     if setp c == 1
-    then loop setp (Scanning.store_char max ib c)
-    else max in
+    then loop setp (Scanning.store_char width ib c)
+    else width in
 
-  let max =
+  let width =
     match char_set with
     | Pos_set set ->
       begin match String.length set with
-      | 0 -> loop (fun _ -> 0) max
-      | 1 -> loop_pos1 set.[0] max
-      | 2 -> loop_pos2 set.[0] set.[1] max
-      | 3 when set.[1] != '-' -> loop_pos3 set.[0] set.[1] set.[2] max
-      | _ -> loop (find_setp stp char_set) max end
+      | 0 -> loop (fun _ -> 0) width
+      | 1 -> loop_pos1 set.[0] width
+      | 2 -> loop_pos2 set.[0] set.[1] width
+      | 3 when set.[1] != '-' -> loop_pos3 set.[0] set.[1] set.[2] width
+      | _ -> loop (find_setp stp char_set) width end
     | Neg_set set ->
       begin match String.length set with
-      | 0 -> loop (fun _ -> 1) max
-      | 1 -> loop_neg1 set.[0] max
-      | 2 -> loop_neg2 set.[0] set.[1] max
-      | 3 when set.[1] != '-' -> loop_neg3 set.[0] set.[1] set.[2] max
-      | _ -> loop (find_setp stp char_set) max end in
+      | 0 -> loop (fun _ -> 1) width
+      | 1 -> loop_neg1 set.[0] width
+      | 2 -> loop_neg2 set.[0] set.[1] width
+      | 3 when set.[1] != '-' -> loop_neg3 set.[0] set.[1] set.[2] width
+      | _ -> loop (find_setp stp char_set) width end in
   ignore_stoppers stp ib;
-  max
+  width
 ;;
 
 let get_count t ib =
@@ -1317,16 +1314,19 @@ let scan_format ib ef fmt rv f =
 
     let rec scan_fmt ir f i =
       if i > lim then ir, f else
-      match Sformat.get fmt i with
+      match Sformat.unsafe_get fmt i with
       | ' ' -> skip_whites ib; scan_fmt ir f (succ i)
       | '%' -> scan_skip ir f (succ i)
-      | '@' ->
-        let i = succ i in
-        if i > lim then incomplete_format fmt else begin
-        check_char ib (Sformat.get fmt i);
-        scan_fmt ir f (succ i) end
+      | '@' -> skip_indication ir f (succ i)
       | c -> check_char ib c; scan_fmt ir f (succ i)
 
+    and skip_indication ir f i =
+     if i < lim then
+       match Sformat.unsafe_get fmt i with
+       | '@' | '%' as c -> check_char ib c; scan_fmt ir f (succ i)
+       | c -> check_char ib c; scan_fmt ir f i
+     else incomplete_format fmt
+
     and scan_skip ir f i =
       if i > lim then ir, f else
       match Sformat.get fmt i with
@@ -1334,78 +1334,81 @@ let scan_format ib ef fmt rv f =
       | _ -> scan_limits false ir f i
 
     and scan_limits skip ir f i =
-      if i > lim then ir, f else
-      let max_opt, min_opt, i =
+
+      let rec scan_width i =
+        if i > lim then incomplete_format fmt else
         match Sformat.get fmt i with
         | '0' .. '9' as conv ->
-          let rec read_width accu i =
-            if i > lim then accu, i else
-            match Sformat.get fmt i with
-            | '0' .. '9' as c ->
-              let accu = 10 * accu + decimal_value_of_char c in
-              read_width accu (succ i)
-            | _ -> accu, i in
-
-          let max, i = read_width (decimal_value_of_char conv) (succ i) in
-
-          if i > lim then incomplete_format fmt else
-          begin
-            match Sformat.get fmt i with
-            | '.' ->
-              let min, i = read_width 0 (succ i) in
-              (Some max, Some min, i)
-            | _ -> Some max, None, i
-          end
-        | _ -> None, None, i in
-
-      scan_conversion skip max_opt min_opt ir f i
-
-    and scan_conversion skip max_opt min_opt ir f i =
+          let width, i = read_int_literal (decimal_value_of_char conv) (succ i) in
+          Some width, i
+        | _ -> None, i
+
+      and scan_precision i =
+        begin
+          match Sformat.get fmt i with
+          | '.' ->
+            let precision, i = read_int_literal 0 (succ i) in
+            (Some precision, i)
+          | _ -> None, i
+        end
+
+      and read_int_literal accu i =
+        if i > lim then accu, i else
+        match Sformat.unsafe_get fmt i with
+        | '0' .. '9' as c ->
+          let accu = 10 * accu + decimal_value_of_char c in
+          read_int_literal accu (succ i)
+        | _ -> accu, i in
+
+      if i > lim then ir, f else
+      let width_opt, i = scan_width i in
+      let prec_opt, i = scan_precision i in
+      scan_conversion skip width_opt prec_opt ir f i
+
+    and scan_conversion skip width_opt prec_opt ir f i =
       let stack = if skip then no_stack else stack in
-      let max = int_max max_opt in
-      let min = int_min min_opt in
+      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)
       | 's' ->
         let i, stp = scan_fmt_stoppers (succ i) in
-        let _x = scan_string stp max ib in
+        let _x = scan_string stp width ib in
         scan_fmt ir (stack f (token_string ib)) (succ i)
       | 'S' ->
-        let _x = scan_String max ib in
+        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 _x = scan_chars_in_char_set stp char_set max ib 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 max = 0 ->
+      | ('c' | 'C') when width = 0 ->
         let c = Scanning.checked_peek_char ib in
         scan_fmt ir (stack f c) (succ i)
       | 'c' ->
-        let _x = scan_char max ib in
+        let _x = scan_char width ib in
         scan_fmt ir (stack f (token_char ib)) (succ i)
       | 'C' ->
-        let _x = scan_Char max ib in
+        let _x = scan_Char width ib in
         scan_fmt ir (stack f (token_char ib)) (succ i)
       | 'd' | 'i' | 'o' | 'u' | 'x' | 'X' as conv ->
-        let _x = scan_int_conv conv max min ib in
+        let _x = scan_int_conv conv width prec ib in
         scan_fmt ir (stack f (token_int conv ib)) (succ i)
       | 'N' as conv ->
         scan_fmt ir (stack f (get_count conv ib)) (succ i)
       | 'f' | 'e' | 'E' | 'g' | 'G' ->
-        let min = float_min min_opt in
-        let _x = scan_float max min ib in
+        let _x = scan_float width prec ib in
         scan_fmt ir (stack f (token_float ib)) (succ i)
       | 'F' ->
-        let min = float_min min_opt in
-        let _x = scan_Float max min ib in
+        let _x = scan_Float width prec ib in
         scan_fmt ir (stack f (token_float ib)) (succ i)
-(*      | 'B' | 'b' when max = Some 0 ->
-        let _x = scan_bool max ib in
+(*      | 'B' | 'b' when width = Some 0 ->
+        let _x = scan_bool width ib in
         scan_fmt ir (stack f (token_int ib)) (succ i) *)
       | 'B' | 'b' ->
-        let _x = scan_bool max ib in
+        let _x = scan_bool width ib in
         scan_fmt ir (stack f (token_bool ib)) (succ i)
       | 'r' ->
         if ir > limr then assert false else
@@ -1417,7 +1420,7 @@ let scan_format ib ef fmt rv f =
         match Sformat.get fmt i with
         (* This is in fact an integer conversion (e.g. %ld, %ni, or %Lo). *)
         | 'd' | 'i' | 'o' | 'u' | 'x' | 'X' as conv1 ->
-          let _x = scan_int_conv conv1 max min ib in
+          let _x = scan_int_conv conv1 width prec ib in
           (* Look back to the character that triggered the integer conversion
              (this character is either 'l', 'n' or 'L') to find the
              conversion to apply to the integer token read. *)
@@ -1441,7 +1444,7 @@ let scan_format ib ef fmt rv f =
         let mf = Sformat.sub fmt (Sformat.index_of_int i) (j - 2 - i) in
         (* Read the specified format string in the input buffer,
            and check its correctness. *)
-        let _x = scan_String max ib in
+        let _x = scan_String width ib in
         let rf = token_string ib in
         if not (compatible_format_type rf mf) then format_mismatch rf mf else
         (* For conversion %{%}, just return this format string as the token
@@ -1517,3 +1520,9 @@ let string_to_String s =
 let format_from_string s fmt =
   sscanf_format (string_to_String s) fmt (fun x -> x)
 ;;
+
+(*
+ Local Variables:
+  compile-command: "cd ..; make world"
+  End:
+*)
diff --git a/stdlib/scanf.mli b/stdlib/scanf.mli
index 38cbad8656..1e8a744840 100644
--- a/stdlib/scanf.mli
+++ b/stdlib/scanf.mli
@@ -232,14 +232,21 @@ val bscanf : Scanning.in_channel -> ('a, 'b, 'c, 'd) scanner;;
 
 (** {6 Format string description} *)
 
-(** The format is a character string which contains three types of
+(** The format string 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}). *)
+      (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
+*)
 
 (** {7:space The space character in format strings} *)
 
@@ -262,139 +269,153 @@ val bscanf : Scanning.in_channel -> ('a, 'b, 'c, 'd) scanner;;
 
 (** {7:conversion Conversion specifications in format strings} *)
 
-(** 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-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 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 [\]].
-    - [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 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. *)
+(** 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. *)
 
 (** {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
-    indication is introduced by a [@] character, followed by some
-    constant character [c]. It means that the string token should end
+    indication is introduced by a [\@] character, followed by some
+    literal 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 to the end of input. If a scanning
-    indication [\@c] does not follow a string conversion, it is treated
-    as a plain [c] character.
+    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.
 
     Note:
 
@@ -487,3 +508,9 @@ val format_from_string :
     have the same type as [fmt].
     @since 3.10.0
 *)
+
+(*
+ Local Variables:
+  compile-command: "cd ..; make world"
+  End:
+*)
diff --git a/toplevel/toplevellib.mllib b/toplevel/toplevellib.mllib
index a5e8b03f24..eb459a906d 100644
--- a/toplevel/toplevellib.mllib
+++ b/toplevel/toplevellib.mllib
@@ -1,7 +1,7 @@
 Myocamlbuild_config
 Misc Tbl Config Clflags Terminfo Ccomp Warnings Consistbl
 
-Linenum Location Longident Syntaxerr Parser
+Location Longident Syntaxerr Parser
 Lexer Parse Printast
 
 Unused_var Ident Path Primitive Types
diff --git a/typing/ctype.ml b/typing/ctype.ml
index e346b1eab5..319bec1c39 100644
--- a/typing/ctype.ml
+++ b/typing/ctype.ml
@@ -1014,6 +1014,7 @@ let new_declaration newtype manifest =
     type_manifest = manifest;
     type_variance = [];
     type_newtype_level = newtype;
+    type_loc = Location.none;
   }
 
 let instance_constructor ?in_pattern cstr =
@@ -3985,6 +3986,7 @@ let nondep_type_decl env mid id is_covariant decl =
       type_private = priv;
       type_variance = decl.type_variance;
       type_newtype_level = None;
+      type_loc = decl.type_loc;
     }
   with Not_found ->
     clear_hash ();
diff --git a/typing/includemod.ml b/typing/includemod.ml
index 21dd58e10d..70112c7b27 100644
--- a/typing/includemod.ml
+++ b/typing/includemod.ml
@@ -19,7 +19,7 @@ open Path
 open Types
 open Typedtree
 
-type error =
+type symptom =
     Missing_field of Ident.t
   | Value_descriptions of Ident.t * value_description * value_description
   | Type_declarations of Ident.t * type_declaration
@@ -38,6 +38,10 @@ type error =
       Ctype.class_match_failure list
   | Unbound_modtype_path of Path.t
 
+type pos =
+    Module of Ident.t | Modtype of Ident.t | Arg of Ident.t | Body of Ident.t
+type error = pos list * symptom
+
 exception Error of error list
 
 (* All functions "blah env x1 x2" check that x1 is included in x2,
@@ -46,51 +50,52 @@ exception Error of error list
 
 (* Inclusion between value descriptions *)
 
-let value_descriptions env subst id vd1 vd2 =
+let value_descriptions env cxt subst id vd1 vd2 =
   let vd2 = Subst.value_description subst vd2 in
   try
     Includecore.value_descriptions env vd1 vd2
   with Includecore.Dont_match ->
-    raise(Error[Value_descriptions(id, vd1, vd2)])
+    raise(Error[cxt, Value_descriptions(id, vd1, vd2)])
 
 (* Inclusion between type declarations *)
 
-let type_declarations env subst id decl1 decl2 =
+let type_declarations env cxt subst id decl1 decl2 =
   let decl2 = Subst.type_declaration subst decl2 in
   let err = Includecore.type_declarations env id decl1 decl2 in
-  if err <> [] then raise(Error[Type_declarations(id, decl1, decl2, err)])
+  if err <> [] then raise(Error[cxt, Type_declarations(id, decl1, decl2, err)])
 
 (* Inclusion between exception declarations *)
 
-let exception_declarations env subst id decl1 decl2 =
+let exception_declarations env cxt subst id decl1 decl2 =
   let decl2 = Subst.exception_declaration subst decl2 in
   if Includecore.exception_declarations env decl1 decl2
   then ()
-  else raise(Error[Exception_declarations(id, decl1, decl2)])
+  else raise(Error[cxt, Exception_declarations(id, decl1, decl2)])
 
 (* Inclusion between class declarations *)
 
-let class_type_declarations env subst id decl1 decl2 =
+let class_type_declarations env cxt subst id decl1 decl2 =
   let decl2 = Subst.cltype_declaration subst decl2 in
   match Includeclass.class_type_declarations env decl1 decl2 with
     []     -> ()
-  | reason -> raise(Error[Class_type_declarations(id, decl1, decl2, reason)])
+  | reason ->
+      raise(Error[cxt, Class_type_declarations(id, decl1, decl2, reason)])
 
-let class_declarations env subst id decl1 decl2 =
+let class_declarations env cxt subst id decl1 decl2 =
   let decl2 = Subst.class_declaration subst decl2 in
   match Includeclass.class_declarations env decl1 decl2 with
     []     -> ()
-  | reason -> raise(Error[Class_declarations(id, decl1, decl2, reason)])
+  | reason -> raise(Error[cxt, Class_declarations(id, decl1, decl2, reason)])
 
 (* Expand a module type identifier when possible *)
 
 exception Dont_match
 
-let expand_module_path env path =
+let expand_module_path env cxt path =
   try
     Env.find_modtype_expansion path env
   with Not_found ->
-    raise(Error[Unbound_modtype_path path])
+    raise(Error[cxt, Unbound_modtype_path path])
 
 (* Extract name, kind and ident from a signature item *)
 
@@ -128,28 +133,29 @@ let simplify_structure_coercion cc =
    Return the restriction that transforms a value of the smaller type
    into a value of the bigger type. *)
 
-let rec modtypes env subst mty1 mty2 =
+let rec modtypes env cxt subst mty1 mty2 =
   try
-    try_modtypes env subst mty1 mty2
+    try_modtypes env cxt subst mty1 mty2
   with
     Dont_match ->
-      raise(Error[Module_types(mty1, Subst.modtype subst mty2)])
+      raise(Error[cxt, Module_types(mty1, Subst.modtype subst mty2)])
   | Error reasons ->
-      raise(Error(Module_types(mty1, Subst.modtype subst mty2) :: reasons))
+      raise(Error((cxt, Module_types(mty1, Subst.modtype subst mty2))
+                  :: reasons))
 
-and try_modtypes env subst mty1 mty2 =
+and try_modtypes env cxt subst mty1 mty2 =
   match (mty1, mty2) with
     (_, Tmty_ident p2) ->
-      try_modtypes2 env mty1 (Subst.modtype subst mty2)
+      try_modtypes2 env cxt mty1 (Subst.modtype subst mty2)
   | (Tmty_ident p1, _) ->
-      try_modtypes env subst (expand_module_path env p1) mty2
+      try_modtypes env cxt subst (expand_module_path env cxt p1) mty2
   | (Tmty_signature sig1, Tmty_signature sig2) ->
-      signatures env subst sig1 sig2
+      signatures env cxt subst sig1 sig2
   | (Tmty_functor(param1, arg1, res1), Tmty_functor(param2, arg2, res2)) ->
       let arg2' = Subst.modtype subst arg2 in
-      let cc_arg = modtypes env Subst.identity arg2' arg1 in
+      let cc_arg = modtypes env (Arg param1::cxt) Subst.identity arg2' arg1 in
       let cc_res =
-        modtypes (Env.add_module param1 arg2' env)
+        modtypes (Env.add_module param1 arg2' env) (Body param1::cxt)
           (Subst.add_module param2 (Pident param1) subst) res1 res2 in
       begin match (cc_arg, cc_res) with
           (Tcoerce_none, Tcoerce_none) -> Tcoerce_none
@@ -158,19 +164,19 @@ and try_modtypes env subst mty1 mty2 =
   | (_, _) ->
       raise Dont_match
 
-and try_modtypes2 env mty1 mty2 =
+and try_modtypes2 env cxt mty1 mty2 =
   (* mty2 is an identifier *)
   match (mty1, mty2) with
     (Tmty_ident p1, Tmty_ident p2) when Path.same p1 p2 ->
       Tcoerce_none
   | (_, Tmty_ident p2) ->
-      try_modtypes env Subst.identity mty1 (expand_module_path env p2)
+      try_modtypes env cxt Subst.identity mty1 (expand_module_path env cxt p2)
   | (_, _) ->
       assert false
 
 (* Inclusion between signatures *)
 
-and signatures env subst sig1 sig2 =
+and signatures env cxt subst sig1 sig2 =
   (* Environment used to check inclusion of components *)
   let new_env =
     Env.add_signature sig1 env in
@@ -202,7 +208,7 @@ and signatures env subst sig1 sig2 =
   let rec pair_components subst paired unpaired = function
       [] ->
         begin match unpaired with
-            [] -> signature_components new_env subst (List.rev paired)
+            [] -> signature_components new_env cxt subst (List.rev paired)
           | _  -> raise(Error unpaired)
         end
     | item2 :: rem ->
@@ -234,7 +240,7 @@ and signatures env subst sig1 sig2 =
             ((item1, item2, pos1) :: paired) unpaired rem
         with Not_found ->
           let unpaired =
-            if report then Missing_field id2 :: unpaired else unpaired in
+            if report then (cxt, Missing_field id2) :: unpaired else unpaired in
           pair_components subst paired unpaired rem
         end in
   (* Do the pairing and checking, and return the final coercion *)
@@ -242,65 +248,67 @@ and signatures env subst sig1 sig2 =
 
 (* Inclusion between signature components *)
 
-and signature_components env subst = function
+and signature_components env cxt subst = function
     [] -> []
   | (Tsig_value(id1, valdecl1), Tsig_value(id2, valdecl2), pos) :: rem ->
-      let cc = value_descriptions env subst id1 valdecl1 valdecl2 in
+      let cc = value_descriptions env cxt subst id1 valdecl1 valdecl2 in
       begin match valdecl2.val_kind with
-        Val_prim p -> signature_components env subst rem
-      | _ -> (pos, cc) :: signature_components env subst rem
+        Val_prim p -> signature_components env cxt subst rem
+      | _ -> (pos, cc) :: signature_components env cxt subst rem
       end
   | (Tsig_type(id1, tydecl1, _), Tsig_type(id2, tydecl2, _), pos) :: rem ->
-      type_declarations env subst id1 tydecl1 tydecl2;
-      signature_components env subst rem
+      type_declarations env cxt subst id1 tydecl1 tydecl2;
+      signature_components env cxt subst rem
   | (Tsig_exception(id1, excdecl1), Tsig_exception(id2, excdecl2), pos)
     :: rem ->
-      exception_declarations env subst id1 excdecl1 excdecl2;
-      (pos, Tcoerce_none) :: signature_components env subst rem
+      exception_declarations env cxt subst id1 excdecl1 excdecl2;
+      (pos, Tcoerce_none) :: signature_components env cxt subst rem
   | (Tsig_module(id1, mty1, _), Tsig_module(id2, mty2, _), pos) :: rem ->
       let cc =
-        modtypes env subst (Mtype.strengthen env mty1 (Pident id1)) mty2 in
-      (pos, cc) :: signature_components env subst rem
+        modtypes env (Module id1::cxt) subst
+          (Mtype.strengthen env mty1 (Pident id1)) mty2 in
+      (pos, cc) :: signature_components env cxt subst rem
   | (Tsig_modtype(id1, info1), Tsig_modtype(id2, info2), pos) :: rem ->
-      modtype_infos env subst id1 info1 info2;
-      signature_components env subst rem
+      modtype_infos env cxt subst id1 info1 info2;
+      signature_components env cxt subst rem
   | (Tsig_class(id1, decl1, _), Tsig_class(id2, decl2, _), pos) :: rem ->
-      class_declarations env subst id1 decl1 decl2;
-      (pos, Tcoerce_none) :: signature_components env subst rem
+      class_declarations env cxt subst id1 decl1 decl2;
+      (pos, Tcoerce_none) :: signature_components env cxt subst rem
   | (Tsig_cltype(id1, info1, _), Tsig_cltype(id2, info2, _), pos) :: rem ->
-      class_type_declarations env subst id1 info1 info2;
-      signature_components env subst rem
+      class_type_declarations env cxt subst id1 info1 info2;
+      signature_components env cxt subst rem
   | _ ->
       assert false
 
 (* Inclusion between module type specifications *)
 
-and modtype_infos env subst id info1 info2 =
+and modtype_infos env cxt subst id info1 info2 =
   let info2 = Subst.modtype_declaration subst info2 in
+  let cxt' = Modtype id :: cxt in
   try
     match (info1, info2) with
       (Tmodtype_abstract, Tmodtype_abstract) -> ()
     | (Tmodtype_manifest mty1, Tmodtype_abstract) -> ()
     | (Tmodtype_manifest mty1, Tmodtype_manifest mty2) ->
-        check_modtype_equiv env mty1 mty2
+        check_modtype_equiv env cxt' mty1 mty2
     | (Tmodtype_abstract, Tmodtype_manifest mty2) ->
-        check_modtype_equiv env (Tmty_ident(Pident id)) mty2
+        check_modtype_equiv env cxt' (Tmty_ident(Pident id)) mty2
   with Error reasons ->
-    raise(Error(Modtype_infos(id, info1, info2) :: reasons))
+    raise(Error((cxt, Modtype_infos(id, info1, info2)) :: reasons))
 
-and check_modtype_equiv env mty1 mty2 =
+and check_modtype_equiv env cxt mty1 mty2 =
   match
-    (modtypes env Subst.identity mty1 mty2,
-     modtypes env Subst.identity mty2 mty1)
+    (modtypes env cxt Subst.identity mty1 mty2,
+     modtypes env cxt Subst.identity mty2 mty1)
   with
     (Tcoerce_none, Tcoerce_none) -> ()
-  | (_, _) -> raise(Error [Modtype_permutation])
+  | (_, _) -> raise(Error [cxt, Modtype_permutation])
 
 (* Simplified inclusion check between module types (for Env) *)
 
 let check_modtype_inclusion env mty1 path1 mty2 =
   try
-    ignore(modtypes env Subst.identity
+    ignore(modtypes env [] Subst.identity
                     (Mtype.strengthen env mty1 path1) mty2)
   with Error reasons ->
     raise Not_found
@@ -312,36 +320,46 @@ let _ = Env.check_modtype_inclusion := check_modtype_inclusion
 
 let compunit impl_name impl_sig intf_name intf_sig =
   try
-    signatures Env.initial Subst.identity impl_sig intf_sig
+    signatures Env.initial [] Subst.identity impl_sig intf_sig
   with Error reasons ->
-    raise(Error(Interface_mismatch(impl_name, intf_name) :: reasons))
+    raise(Error(([], Interface_mismatch(impl_name, intf_name)) :: reasons))
 
-(* Hide the substitution parameter to the outside world *)
+(* 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 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
+  type_declarations env [] Subst.identity id decl1 decl2
 
 (* Error report *)
 
 open Format
 open Printtyp
 
+let show_loc msg ppf loc =
+  let pos = loc.Location.loc_start in
+  if List.mem pos.Lexing.pos_fname [""; "_none_"; "//toplevel//"] then ()
+  else fprintf ppf "@\n@[<2>%a:@ %s@]" Location.print_loc loc msg
+
+let show_locs ppf (loc1, loc2) =
+  show_loc "Expected declaration" ppf loc2;
+  show_loc "Actual declaration" ppf loc1
+
 let include_err ppf = function
   | Missing_field id ->
       fprintf ppf "The field `%a' is required but not provided" ident id
   | Value_descriptions(id, d1, d2) ->
       fprintf ppf
-       "@[<hv 2>Values do not match:@ \
-        %a@;<1 -2>is not included in@ %a@]"
-       (value_description id) d1 (value_description id) d2
+        "@[<hv 2>Values do not match:@ %a@;<1 -2>is not included in@ %a@]"
+        (value_description id) d1 (value_description id) d2;
+      show_locs ppf (d1.val_loc, d2.val_loc);
   | Type_declarations(id, d1, d2, errs) ->
-      fprintf ppf "@[@[<hv>%s:@;<1 2>%a@ %s@;<1 2>%a@]%a@]"
+      fprintf ppf "@[<v>@[<hv>%s:@;<1 2>%a@ %s@;<1 2>%a@]%a%a@]"
         "Type declarations do not match"
         (type_declaration id) d1
         "is not included in"
         (type_declaration id) d2
+        show_locs (d1.type_loc, d2.type_loc)
         (Includecore.report_type_mismatch
            "the first" "the second" "declaration") errs
   | Exception_declarations(id, d1, d2) ->
@@ -384,9 +402,65 @@ let include_err ppf = function
   | Unbound_modtype_path path ->
       fprintf ppf "Unbound module type %a" Printtyp.path path
 
-let report_error ppf = function
-  |  [] -> ()
-  | err :: errs ->
-      let print_errs ppf errs =
-         List.iter (fun err -> fprintf ppf "@ %a" include_err err) errs in
-      fprintf ppf "@[<v>%a%a@]" include_err err print_errs errs
+let rec context ppf = function
+    Module id :: rem ->
+      fprintf ppf "@[<2>module %a%a@]" ident id args rem
+  | Modtype id :: rem ->
+      fprintf ppf "@[<2>module type %a =@ %a@]" ident id context_mty rem
+  | Body x :: rem ->
+      fprintf ppf "functor (%a) ->@ %a" ident x context_mty rem
+  | Arg x :: rem ->
+      fprintf ppf "functor (%a : %a) -> ..." ident x context_mty rem
+  | [] ->
+      fprintf ppf "<here>"
+and context_mty ppf = function
+    (Module _ | Modtype _) :: _ as rem ->
+      fprintf ppf "@[<2>sig@ %a@;<1 -2>end@]" context rem
+  | cxt -> context ppf cxt
+and args ppf = function
+    Body x :: rem ->
+      fprintf ppf "(%a)%a" ident x args rem
+  | Arg x :: rem ->
+      fprintf ppf "(%a :@ %a) : ..." ident x context_mty rem
+  | cxt ->
+      fprintf ppf " :@ %a" context_mty cxt
+
+let path_of_context = function
+    Module id :: rem ->
+      let rec subm path = function
+          [] -> path
+        | Module id :: rem -> subm (Pdot (path, Ident.name id, -1)) rem
+        | _ -> assert false
+      in subm (Pident id) rem
+  | _ -> assert false
+
+let context ppf cxt =
+  if cxt = [] then () else
+  if List.for_all (function Module _ -> true | _ -> false) cxt then
+    fprintf ppf "In module %a:@ " path (path_of_context cxt)
+  else
+    fprintf ppf "@[<hv 2>At position@ %a@]@ " context cxt
+
+let include_err ppf (cxt, err) =
+  fprintf ppf "@[<v>%a%a@]" context (List.rev cxt) include_err err
+
+let buffer = ref ""
+let is_big obj =
+  let size = !Clflags.error_size in
+  size > 0 &&
+  begin
+    if String.length !buffer < size then buffer := String.create size;
+    try ignore (Marshal.to_buffer !buffer 0 size obj []); false
+    with _ -> true
+  end
+
+let report_error ppf errs =
+  if errs = [] then () else
+  let (errs , err) = split_last errs in
+  let pe = ref true in
+  let include_err' ppf err =
+    if not (is_big err) then fprintf ppf "%a@ " include_err err
+    else if !pe then (fprintf ppf "...@ "; pe := false)
+  in
+  let print_errs ppf = List.iter (include_err' ppf) in
+  fprintf ppf "@[<v>%a%a@]" print_errs errs include_err err
diff --git a/typing/includemod.mli b/typing/includemod.mli
index 35e8dfb7e6..c1c9c1f0c0 100644
--- a/typing/includemod.mli
+++ b/typing/includemod.mli
@@ -24,7 +24,7 @@ val compunit: string -> signature -> string -> signature -> module_coercion
 val type_declarations:
       Env.t -> Ident.t -> type_declaration -> type_declaration -> unit
 
-type error =
+type symptom =
     Missing_field of Ident.t
   | Value_descriptions of Ident.t * value_description * value_description
   | Type_declarations of Ident.t * type_declaration
@@ -43,6 +43,10 @@ type error =
       Ctype.class_match_failure list
   | Unbound_modtype_path of Path.t
 
+type pos =
+    Module of Ident.t | Modtype of Ident.t | Arg of Ident.t | Body of Ident.t
+type error = pos list * symptom
+
 exception Error of error list
 
 val report_error: formatter -> error list -> unit
diff --git a/typing/mtype.ml b/typing/mtype.ml
index 9e18d237b4..404dda95bc 100644
--- a/typing/mtype.ml
+++ b/typing/mtype.ml
@@ -110,7 +110,9 @@ let nondep_supertype env mid mty =
       match item with
         Tsig_value(id, d) ->
           Tsig_value(id, {val_type = Ctype.nondep_type env mid d.val_type;
-                          val_kind = d.val_kind}) :: rem'
+                          val_kind = d.val_kind;
+                          val_loc = d.val_loc;
+                         }) :: rem'
       | Tsig_type(id, d, rs) ->
           Tsig_type(id, Ctype.nondep_type_decl env mid id (va = Co) d, rs)
           :: rem'
diff --git a/typing/predef.ml b/typing/predef.ml
index 23025d47a9..8ba37fab0c 100644
--- a/typing/predef.ml
+++ b/typing/predef.ml
@@ -89,6 +89,7 @@ let build_initial_env add_type add_exception empty_env =
     {type_params = [];
      type_arity = 0;
      type_kind = Type_abstract;
+     type_loc = Location.none;
      type_private = Public;
      type_manifest = None;
      type_variance = [];
@@ -97,6 +98,7 @@ let build_initial_env add_type add_exception empty_env =
     {type_params = [];
      type_arity = 0;
      type_kind = Type_variant(["false", [], None; "true", [], None]);
+     type_loc = Location.none;
      type_private = Public;
      type_manifest = None;
      type_variance = [];
@@ -105,6 +107,7 @@ let build_initial_env add_type add_exception empty_env =
     {type_params = [];
      type_arity = 0;
      type_kind = Type_variant(["()", [], None]);
+     type_loc = Location.none;
      type_private = Public;
      type_manifest = None;
      type_variance = [];
@@ -113,6 +116,7 @@ let build_initial_env add_type add_exception empty_env =
     {type_params = [];
      type_arity = 0;
      type_kind = Type_variant [];
+     type_loc = Location.none;
      type_private = Public;
      type_manifest = None;
      type_variance = [];
@@ -122,6 +126,7 @@ let build_initial_env add_type add_exception empty_env =
     {type_params = [tvar];
      type_arity = 1;
      type_kind = Type_abstract;
+     type_loc = Location.none;
      type_private = Public;
      type_manifest = None;
      type_variance = [true, true, true];
@@ -132,6 +137,7 @@ let build_initial_env add_type add_exception empty_env =
      type_arity = 1;
      type_kind =
      Type_variant(["[]", [], None; "::", [tvar; type_list tvar], None]);
+     type_loc = Location.none;
      type_private = Public;
      type_manifest = None;
      type_variance = [true, false, false];
@@ -143,6 +149,7 @@ let build_initial_env add_type add_exception empty_env =
    ];
      type_arity = 6;
      type_kind = Type_abstract;
+     type_loc = Location.none;
      type_private = Public;
      type_manifest = None;
      type_variance = [
@@ -156,6 +163,7 @@ let build_initial_env add_type add_exception empty_env =
     {type_params = [tvar];
      type_arity = 1;
      type_kind = Type_variant(["None", [], None; "Some", [tvar], None]);
+     type_loc = Location.none;
      type_private = Public;
      type_manifest = None;
      type_variance = [true, false, false];
@@ -165,6 +173,7 @@ let build_initial_env add_type add_exception empty_env =
     {type_params = [tvar];
      type_arity = 1;
      type_kind = Type_abstract;
+     type_loc = Location.none;
      type_private = Public;
      type_manifest = None;
      type_variance = [true, false, false];
diff --git a/typing/subst.ml b/typing/subst.ml
index f9c5d6bc90..cd8a24e350 100644
--- a/typing/subst.ml
+++ b/typing/subst.ml
@@ -179,9 +179,7 @@ let type_declaration s decl =
               (List.map (fun (n, mut, arg) -> (n, mut, typexp s arg)) lbls,
                rep)
         end;
-
       type_manifest =
-
         begin 
 	  match decl.type_manifest with
             None -> None
@@ -190,6 +188,7 @@ let type_declaration s decl =
       type_private = decl.type_private;
       type_variance = decl.type_variance;
       type_newtype_level = None;
+      type_loc = if s.for_saving then Location.none else decl.type_loc;
     }
   in
   cleanup_types ();
@@ -248,7 +247,9 @@ let class_type s cty =
 
 let value_description s descr =
   { val_type = type_expr s descr.val_type;
-    val_kind = descr.val_kind }
+    val_kind = descr.val_kind;
+    val_loc = if s.for_saving then Location.none else descr.val_loc;
+   }
 
 let exception_declaration s tyl =
   List.map (type_expr s) tyl
diff --git a/typing/typeclass.ml b/typing/typeclass.ml
index 4ba902ffb9..c073ca5b69 100644
--- a/typing/typeclass.ml
+++ b/typing/typeclass.ml
@@ -194,11 +194,11 @@ let rc node =
 (* Enter a value in the method environment only *)
 let enter_met_env lab kind ty val_env met_env par_env =
   let (id, val_env) =
-    Env.enter_value lab {val_type = ty; val_kind = Val_unbound} val_env
+    Env.enter_value lab {val_type = ty; val_kind = Val_unbound; val_loc = Location.none} val_env
   in
   (id, val_env,
-   Env.add_value id {val_type = ty; val_kind = kind} met_env,
-   Env.add_value id {val_type = ty; val_kind = Val_unbound} par_env)
+   Env.add_value id {val_type = ty; val_kind = kind; val_loc = Location.none} met_env,
+   Env.add_value id {val_type = ty; val_kind = Val_unbound; val_loc = Location.none} par_env)
 
 (* Enter an instance variable in the environment *)
 let enter_val cl_num vars inh lab mut virt ty val_env met_env par_env loc =
@@ -585,7 +585,9 @@ let rec class_field cl_num self_type meths vars
              in
              let desc =
                {val_type = expr.exp_type;
-                val_kind = Val_ivar (Immutable, cl_num)}
+                val_kind = Val_ivar (Immutable, cl_num);
+                val_loc = Location.none;
+               }
              in
              let id' = Ident.create (Ident.name id) in
              ((id', expr)
@@ -940,7 +942,9 @@ and class_expr cl_num val_env met_env scl =
              Ctype.generalize expr.exp_type;
              let desc =
                {val_type = expr.exp_type; val_kind = Val_ivar (Immutable,
-                                                               cl_num)}
+                                                               cl_num);
+                val_loc = Location.none;
+               }
              in
              let id' = Ident.create (Ident.name id) in
              ((id', expr)
@@ -1024,7 +1028,8 @@ let temp_abbrev env id arity =
        type_manifest = Some ty;
        type_variance = List.map (fun _ -> true, true, true) !params;
        type_newtype_level = None;
-     }
+       type_loc = Location.none;
+      }
       env
   in
   (!params, ty, env)
@@ -1238,7 +1243,7 @@ let class_infos define_class kind
      type_manifest = Some obj_ty;
      type_variance = List.map (fun _ -> true, true, true) obj_params;
      type_newtype_level = None;
-   }
+     type_loc = cl.pci_loc}
   in
   let (cl_params, cl_ty) =
     Ctype.instance_parameterized_type params (Ctype.self_type typ)
@@ -1252,8 +1257,8 @@ let class_infos define_class kind
      type_private = Public;
      type_manifest = Some cl_ty;
      type_variance = List.map (fun _ -> true, true, true) cl_params;
-     type_newtype_level = None
-   }
+     type_newtype_level = None;
+     type_loc = cl.pci_loc}
   in
   ((cl, id, clty, ty_id, cltydef, obj_id, obj_abbr, cl_id, cl_abbr,
     arity, pub_meths, List.rev !coercion_locs, expr) :: res,
diff --git a/typing/typecore.ml b/typing/typecore.ml
index 5fb6d991cd..9deb1be40b 100644
--- a/typing/typecore.ml
+++ b/typing/typecore.ml
@@ -151,7 +151,7 @@ let rec extract_label_names sexp env ty =
 (* Typing of patterns *)
 
 (* unification inside type_pat*)
-let unify_pat_types loc env ty ty' = 
+let unify_pat_types loc env ty ty' =
   try
     unify env ty ty'
   with
@@ -174,13 +174,13 @@ let unify_exp_types loc env ty expected_ty =
 
 (* level at which to create the local type declarations *)
 let newtype_level = ref None
-let get_newtype_level () = 
+let get_newtype_level () =
   match !newtype_level with
     Some y -> y
   | None -> assert false
 
-let unify_pat_types_gadt loc env ty ty' = 
-  let newtype_level = 
+let unify_pat_types_gadt loc env ty ty' =
+  let newtype_level =
     match !newtype_level with
     | None -> assert false
     | Some x -> x
@@ -197,7 +197,7 @@ let unify_pat_types_gadt loc env ty ty' =
 
 
 (* Creating new conjunctive types is not allowed when typing patterns *)
-let unify_pat env pat expected_ty  = 
+let unify_pat env pat expected_ty =
   unify_pat_types pat.pat_loc env pat.pat_type expected_ty
 
 (* make all Reither present in open variants *)
@@ -292,7 +292,7 @@ let enter_orpat_variables loc env  p1_vs p2_vs =
             with
             | Unify trace ->
                 raise(Error(loc, Pattern_type_clash(trace)))
-            end ;
+            end;
           (x2,x1)::unify_vars rem1 rem2
           end
       | [],[] -> []
@@ -466,23 +466,23 @@ let check_recordpat_labels loc lbl_pat_list closed =
         end
       end
 
-(* unification of a type with a tconstr with 
-   freshly created arguments *) 
-let unify_head_only loc env ty constr = 
+(* unification of a type with a tconstr with
+   freshly created arguments *)
+let unify_head_only loc env ty constr =
   let (_, ty_res) = instance_constructor constr in
   match (repr ty_res).desc with
   | Tconstr(p,args,m) ->
-      ty_res.desc <- Tconstr(p,List.map (fun _ -> newvar ()) args,m); 
+      ty_res.desc <- Tconstr(p,List.map (fun _ -> newvar ()) args,m);
       enforce_constraints env ty_res;
-      unify_pat_types loc env ty ty_res 
+      unify_pat_types loc env ty ty_res
   | _ -> assert false
 
 (* Typing of patterns *)
 
 (* type_pat does not generate local constraints inside or patterns *)
-type type_pat_mode = 
-  | Normal 
-  | Inside_or 
+type type_pat_mode =
+  | Normal
+  | Inside_or
 
 (* type_pat propagates the expected type as well as maps for
    constructors and labels.
@@ -498,7 +498,7 @@ let rec type_pat ~constrs ~labels ~no_existentials ~mode ~env sp expected_ty =
         pat_loc = loc;
         pat_type = expected_ty;
         pat_env = !env }
-  | Ppat_var name -> 
+  | Ppat_var name ->
       let id = enter_variable loc name expected_ty in
       rp {
         pat_desc = Tpat_var id;
@@ -516,7 +516,7 @@ let rec type_pat ~constrs ~labels ~no_existentials ~mode ~env sp expected_ty =
                     ({ptyp_desc=Ptyp_poly _} as sty)) ->
       (* explicitly polymorphic type *)
       let ty, force = Typetexp.transl_simple_type_delayed !env sty in
-      unify_pat_types loc !env ty expected_ty;      
+      unify_pat_types loc !env ty expected_ty;
       pattern_force := force :: !pattern_force;
       begin match ty.desc with
       | Tpoly (body, tyl) ->
@@ -531,7 +531,7 @@ let rec type_pat ~constrs ~labels ~no_existentials ~mode ~env sp expected_ty =
                pat_env = !env }
       | _ -> assert false
       end
-  |Ppat_alias(sq, name) -> 
+  | Ppat_alias(sq, name) ->
       let q = type_pat sq expected_ty in
       begin_def ();
       let ty_var = build_as_type !env q in
@@ -543,15 +543,15 @@ let rec type_pat ~constrs ~labels ~no_existentials ~mode ~env sp expected_ty =
         pat_loc = loc;
         pat_type = q.pat_type;
         pat_env = !env }
-  | Ppat_constant cst -> 
+  | Ppat_constant cst ->
       unify_pat_types loc !env (type_constant cst) expected_ty;
       rp {
         pat_desc = Tpat_constant cst;
         pat_loc = loc;
         pat_type = expected_ty;
         pat_env = !env }
-  |Ppat_tuple spl -> 
-      let spl_ann = List.map (fun p -> (p,newvar ())) spl in 
+  | Ppat_tuple spl ->
+      let spl_ann = List.map (fun p -> (p,newvar ())) spl in
       let ty = newty (Ttuple(List.map snd spl_ann)) in
       unify_pat_types loc !env ty expected_ty;
       let pl = List.map (fun (p,t) -> type_pat p t) spl_ann in
@@ -560,8 +560,8 @@ let rec type_pat ~constrs ~labels ~no_existentials ~mode ~env sp expected_ty =
         pat_loc = loc;
         pat_type = expected_ty;
         pat_env = !env }
-  |Ppat_construct(lid, sarg, explicit_arity) -> 
-      let constr = 
+  | Ppat_construct(lid, sarg, explicit_arity) ->
+      let constr =
         match lid, constrs with
           Longident.Lident s, Some constrs when Hashtbl.mem constrs s ->
             Hashtbl.find constrs s
@@ -587,8 +587,8 @@ let rec type_pat ~constrs ~labels ~no_existentials ~mode ~env sp expected_ty =
       if List.length sargs <> constr.cstr_arity then
         raise(Error(loc, Constructor_arity_mismatch(lid,
                                      constr.cstr_arity, List.length sargs)));
-      let (ty_args, ty_res) = 
-        instance_constructor ~in_pattern:(env, get_newtype_level ()) constr  
+      let (ty_args, ty_res) =
+        instance_constructor ~in_pattern:(env, get_newtype_level ()) constr
       in
       if constr.cstr_generalized && mode = Normal then
         unify_pat_types_gadt loc env ty_res expected_ty
@@ -600,7 +600,7 @@ let rec type_pat ~constrs ~labels ~no_existentials ~mode ~env sp expected_ty =
         pat_loc = loc;
         pat_type = expected_ty;
         pat_env = !env }
-  |Ppat_variant(l, sarg) -> 
+  | Ppat_variant(l, sarg) ->
       let arg = may_map (fun p -> type_pat p (newvar())) sarg in
       let arg_type = match arg with None -> [] | Some arg -> [arg.pat_type]  in
       let row = { row_fields =
@@ -631,7 +631,7 @@ let rec type_pat ~constrs ~labels ~no_existentials ~mode ~env sp expected_ty =
           end_def ();
           generalize ty_arg;
           List.iter generalize vars;
-          let instantiated tv  = 
+          let instantiated tv =
             let tv = expand_head !env tv in
             not (is_Tvar tv) || tv.level <> generic_level in
           if List.exists instantiated vars then
@@ -647,34 +647,34 @@ let rec type_pat ~constrs ~labels ~no_existentials ~mode ~env sp expected_ty =
         pat_loc = loc;
         pat_type = expected_ty;
         pat_env = !env }
-  | Ppat_array spl -> 
+  | Ppat_array spl ->
       let ty_elt = newvar() in
-      unify_pat_types 
+      unify_pat_types
         loc !env (instance_def (Predef.type_array ty_elt)) expected_ty;
-      let spl_ann = List.map (fun p -> (p,newvar())) spl in 
+      let spl_ann = List.map (fun p -> (p,newvar())) spl in
       let pl = List.map (fun (p,t) -> type_pat p ty_elt) spl_ann in
       rp {
         pat_desc = Tpat_array pl;
         pat_loc = loc;
         pat_type = expected_ty;
         pat_env = !env }
-  |Ppat_or(sp1, sp2) ->
+  | Ppat_or(sp1, sp2) ->
       let initial_pattern_variables = !pattern_variables in
-      let p1 = type_pat ~mode:Inside_or sp1 expected_ty in 
+      let p1 = type_pat ~mode:Inside_or sp1 expected_ty in
       let p1_variables = !pattern_variables in
-      pattern_variables := initial_pattern_variables ;
-      let p2 = type_pat ~mode:Inside_or sp2 expected_ty in 
+      pattern_variables := initial_pattern_variables;
+      let p2 = type_pat ~mode:Inside_or sp2 expected_ty in
       let p2_variables = !pattern_variables in
       let alpha_env =
         enter_orpat_variables loc !env p1_variables p2_variables in
-      pattern_variables := p1_variables ;
+      pattern_variables := p1_variables;
       rp {
         pat_desc = Tpat_or(p1, alpha_pat alpha_env p2, None);
         pat_loc = loc;
         pat_type = expected_ty;
         pat_env = !env }
-  |Ppat_lazy sp1 -> 
-      let nv = newvar () in 
+  | Ppat_lazy sp1 ->
+      let nv = newvar () in
       unify_pat_types loc !env (instance_def (Predef.type_lazy_t nv)) expected_ty;
       let p1 = type_pat sp1 nv in
       rp {
@@ -682,19 +682,19 @@ let rec type_pat ~constrs ~labels ~no_existentials ~mode ~env sp expected_ty =
         pat_loc = loc;
         pat_type = expected_ty;
         pat_env = !env }
-  |Ppat_constraint(sp, sty) -> 
+  | Ppat_constraint(sp, sty) ->
       let ty, force = Typetexp.transl_simple_type_delayed !env sty in
       unify_pat_types loc !env ty expected_ty;
       let p = type_pat sp expected_ty in
       pattern_force := force :: !pattern_force;
       p
-  |Ppat_type lid -> 
-      let (r,ty) = build_or_pat !env loc lid in 
+  | Ppat_type lid ->
+      let (r,ty) = build_or_pat !env loc lid in
       unify_pat_types loc !env ty expected_ty;
       r
 
 let type_pat ?(allow_existentials=false) ?constrs ?labels
-    ?(lev=get_current_level()) env sp expected_ty = 
+    ?(lev=get_current_level()) env sp expected_ty =
   newtype_level := Some lev;
   try
     let r =
@@ -703,15 +703,15 @@ let type_pat ?(allow_existentials=false) ?constrs ?labels
     iter_pattern (fun p -> p.pat_env <- !env) r;
     newtype_level := None;
     r
-  with e -> 
+  with e ->
     newtype_level := None;
-    raise e  
+    raise e
 
 
 (* this function is passed to Partial.parmatch
-   to type check gadt nonexhaustiveness *) 
-let partial_pred ~lev env expected_ty constrs labels p = 
-  let snap = snapshot () in 
+   to type check gadt nonexhaustiveness *)
+let partial_pred ~lev env expected_ty constrs labels p =
+  let snap = snapshot () in
   try
     reset_pattern None true;
     let typed_p =
@@ -725,46 +725,47 @@ let partial_pred ~lev env expected_ty constrs labels p =
     backtrack snap;
     None
 
-let rec iter3 f lst1 lst2 lst3 = 
+let rec iter3 f lst1 lst2 lst3 =
   match lst1,lst2,lst3 with
   | x1::xs1,x2::xs2,x3::xs3 ->
       f x1 x2 x3;
-      iter3 f xs1 xs2 xs3 
+      iter3 f xs1 xs2 xs3
   | [],[],[] ->
       ()
   | _ ->
       assert false
 
 let get_ref r =
-  let v = !r in r := []; v
+  let v = !r in
+  r := []; v
 
 let add_pattern_variables env =
   let pv = get_ref pattern_variables in
   (List.fold_right
     (fun (id, ty, loc) env ->
-       let e1 = Env.add_value id {val_type = ty; val_kind = Val_reg} env in
+       let e1 = Env.add_value id {val_type = ty; val_kind = Val_reg; val_loc = loc} env in
        Env.add_annot id (Annot.Iref_internal loc) e1
     )
     pv env,
    get_ref module_variables)
 
-let type_pattern ~lev env spat scope expected_ty  = 
+let type_pattern ~lev env spat scope expected_ty =
   reset_pattern scope true;
-  let new_env = ref env in 
+  let new_env = ref env in
   let pat = type_pat ~allow_existentials:true ~lev new_env spat expected_ty in
   let new_env, unpacks = add_pattern_variables !new_env in
   (pat, new_env, get_ref pattern_force, unpacks)
 
 let type_pattern_list env spatl scope expected_tys allow =
   reset_pattern scope allow;
-  let new_env = ref env in 
+  let new_env = ref env in
   let patl = List.map2 (type_pat new_env) spatl expected_tys in
   let new_env, unpacks = add_pattern_variables !new_env in
   (patl, new_env, get_ref pattern_force, unpacks)
 
 let type_class_arg_pattern cl_num val_env met_env l spat =
   reset_pattern None false;
-  let nv = newvar () in 
+  let nv = newvar () in
   let pat = type_pat (ref val_env) spat nv in
   if has_variants pat then begin
     Parmatch.pressure_variants val_env [pat];
@@ -774,11 +775,13 @@ let type_class_arg_pattern cl_num val_env met_env l spat =
   if is_optional l then unify_pat val_env pat (type_option (newvar ()));
   let (pv, met_env) =
     List.fold_right
-      (fun (id, ty, _loc) (pv, env) ->
+      (fun (id, ty, loc) (pv, env) ->
          let id' = Ident.create (Ident.name id) in
          ((id', id, ty)::pv,
           Env.add_value id' {val_type = ty;
-                             val_kind = Val_ivar (Immutable, cl_num)}
+                             val_kind = Val_ivar (Immutable, cl_num);
+                             val_loc = loc;
+                            }
             env))
       !pattern_variables ([], met_env)
   in
@@ -793,7 +796,7 @@ let type_self_pattern cl_num privty val_env met_env par_env spat =
                        "selfpat-" ^ cl_num))
   in
   reset_pattern None false;
-  let nv = newvar() in 
+  let nv = newvar() in
   let pat = type_pat (ref val_env) spat nv in
   List.iter (fun f -> f()) (get_ref pattern_force);
   let meths = ref Meths.empty in
@@ -802,12 +805,19 @@ let type_self_pattern cl_num privty val_env met_env par_env spat =
   pattern_variables := [];
   let (val_env, met_env, par_env) =
     List.fold_right
-      (fun (id, ty, _loc) (val_env, met_env, par_env) ->
-         (Env.add_value id {val_type = ty; val_kind = Val_unbound} val_env,
+      (fun (id, ty, loc) (val_env, met_env, par_env) ->
+         (Env.add_value id {val_type = ty;
+                            val_kind = Val_unbound;
+                            val_loc = loc;
+                           } val_env,
           Env.add_value id {val_type = ty;
-                            val_kind = Val_self (meths, vars, cl_num, privty)}
+                            val_kind = Val_self (meths, vars, cl_num, privty);
+                            val_loc = loc;
+                           }
             met_env,
-          Env.add_value id {val_type = ty; val_kind = Val_unbound} par_env))
+          Env.add_value id {val_type = ty; val_kind = Val_unbound;
+                            val_loc = loc;
+                           } par_env))
       pv (val_env, met_env, par_env)
   in
   (pat, meths, vars, val_env, met_env, par_env)
@@ -896,7 +906,11 @@ and is_nonexpansive_opt = function
     None -> true
   | Some e -> is_nonexpansive e
 
-(* Typing of printf formats.
+(* Typing format strings for printing or reading.
+
+   This format strings are used by functions in modules Printf, Format, and
+   Scanf.
+
    (Handling of * modifiers contributed by Thorsten Ohl.) *)
 
 external string_to_format :
@@ -950,7 +964,14 @@ 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
@@ -1206,12 +1227,12 @@ let iter_ppat f p =
   | Ppat_or (p1,p2) -> f p1; f p2
   | Ppat_variant (_, arg) | Ppat_construct (_, arg, _) -> may f arg
   | Ppat_tuple lst ->  List.iter f lst
-  | Ppat_alias (p,_) | Ppat_constraint (p,_) | Ppat_lazy p -> f p 
-  | Ppat_record (args, flag) -> List.iter (fun (_,p) -> f p) args 
+  | Ppat_alias (p,_) | Ppat_constraint (p,_) | Ppat_lazy p -> f p
+  | Ppat_record (args, flag) -> List.iter (fun (_,p) -> f p) args
 
-let contains_polymorphic_variant p = 
-  let rec loop p = 
-    match p.ppat_desc with 
+let contains_polymorphic_variant p =
+  let rec loop p =
+    match p.ppat_desc with
       Ppat_variant _ | Ppat_type _ -> raise Exit
     | _ -> iter_ppat loop p
   in
@@ -1486,11 +1507,11 @@ and type_expect ?in_function env sexp ty_expected =
         exp_type = body.exp_type;
         exp_env = env }
   | Pexp_tuple sexpl ->
-      let subtypes = List.map (fun _ -> newgenvar ()) sexpl in 
+      let subtypes = List.map (fun _ -> newgenvar ()) sexpl in
       let to_unify = newgenty (Ttuple subtypes) in
       unify_exp_types loc env to_unify ty_expected;
-      let expl = 
-        List.map2 (fun body ty -> type_expect env body ty) sexpl subtypes 
+      let expl =
+        List.map2 (fun body ty -> type_expect env body ty) sexpl subtypes
       in
       re {
         exp_desc = Texp_tuple expl;
@@ -1665,7 +1686,9 @@ and type_expect ?in_function env sexp ty_expected =
       let high = type_expect env shigh Predef.type_int in
       let (id, new_env) =
         Env.enter_value param {val_type = instance_def Predef.type_int;
-                                val_kind = Val_reg} env in
+                               val_kind = Val_reg;
+                               val_loc = loc;
+                              } env in
       let body = type_statement new_env sbody in
       rue {
         exp_desc = Texp_for(id, low, high, dir, body);
@@ -1807,7 +1830,9 @@ and type_expect ?in_function env sexp ty_expected =
                   unify env res_ty (instance env typ);
                   (Texp_apply({ exp_desc = Texp_ident(Path.Pident method_id,
                                                      {val_type = method_type;
-                                                       val_kind = Val_reg});
+                                                      val_kind = Val_reg;
+                                                      val_loc = Location.none;
+                                                     });
                                 exp_loc = loc;
                                 exp_type = method_type;
                                 exp_env = env },
@@ -2037,6 +2062,7 @@ and type_expect ?in_function env sexp ty_expected =
         type_manifest = None;
         type_variance = [];
         type_newtype_level = Some (level, level);
+        type_loc = loc;
       }
       in
       let ty = newvar () in
@@ -2097,7 +2123,7 @@ and type_label_exp create env loc ty_expected (label, sarg) =
   (* Here also ty_expected may be at generic_level *)
   begin_def ();
   let separate = !Clflags.principal || Env.has_local_constraints env in
-  if separate then (begin_def (); begin_def ()) ;
+  if separate then (begin_def (); begin_def ());
   let (vars, ty_arg, ty_res) = instance_label true label in
   if separate then begin
     end_def ();
@@ -2190,7 +2216,7 @@ and type_argument env sarg ty_expected' ty_expected =
         {pat_desc = Tpat_var id; pat_type = ty;
          pat_loc = Location.none; pat_env = env},
         {exp_type = ty; exp_loc = Location.none; exp_env = env; exp_desc =
-         Texp_ident(Path.Pident id,{val_type = ty; val_kind = Val_reg})}
+         Texp_ident(Path.Pident id,{val_type = ty; val_kind = Val_reg; val_loc = Location.none})}
       in
       let eta_pat, eta_var = var_pair "eta" ty_arg in
       let func texp =
@@ -2492,13 +2518,13 @@ and type_cases ?in_function env ty_arg ty_res partial_flag loc caselist =
         let loc = sexp.pexp_loc in
         if !Clflags.principal then begin_def (); (* propagation of pattern *)
         let scope = Some (Annot.Idef loc) in
-        let (pat, ext_env, force, unpacks) = 
+        let (pat, ext_env, force, unpacks) =
           let partial =
             if !Clflags.principal then Some false else None in
           let ty_arg =
             if dont_propagate then newvar () else instance ?partial env ty_arg
-          in type_pattern ~lev env spat scope ty_arg 
-        in      
+          in type_pattern ~lev env spat scope ty_arg
+        in
         pattern_force := force @ !pattern_force;
         let pat =
           if !Clflags.principal then begin
@@ -2585,7 +2611,7 @@ and type_let env rec_flag spat_sexp_list scope allow =
         | _ -> spat)
       spat_sexp_list in
   let nvs = List.map (fun _ -> newvar ()) spatl in
-  let (pat_list, new_env, force, unpacks) = 
+  let (pat_list, new_env, force, unpacks) =
     type_pattern_list env spatl scope nvs allow in
   if rec_flag = Recursive then
     List.iter2
@@ -2648,7 +2674,7 @@ and type_let env rec_flag spat_sexp_list scope allow =
          iter_pattern (fun pat -> generalize_expansive env pat.pat_type) pat)
     pat_list exp_list;
   List.iter
-    (fun pat -> iter_pattern 
+    (fun pat -> iter_pattern
       (fun pat -> generalize pat.pat_type) pat)
     pat_list;
   (List.combine pat_list exp_list, new_env, unpacks)
@@ -2842,7 +2868,7 @@ let report_error ppf = function
         (function ppf ->
            fprintf ppf "Recursive local constraint when unifying")
         (function ppf ->
-           fprintf ppf "with")      
+           fprintf ppf "with")
   | Unexpected_existential ->
       fprintf ppf
-        "Unexpected existential"    
+        "Unexpected existential"
diff --git a/typing/typedecl.ml b/typing/typedecl.ml
index 4b62a35f21..8b93fdef61 100644
--- a/typing/typedecl.ml
+++ b/typing/typedecl.ml
@@ -60,6 +60,7 @@ let enter_type env (name, sdecl) id =
         | Some _ -> Some(Ctype.newvar ()) end;
       type_variance = List.map (fun _ -> true, true, true) sdecl.ptype_params;
       type_newtype_level = None;
+      type_loc = sdecl.ptype_loc;
     }
   in
   Env.add_type id decl env
@@ -220,6 +221,7 @@ let transl_declaration env (name, sdecl) id =
         end;
       type_variance = List.map (fun _ -> true, true, true) params;
       type_newtype_level = None;
+      type_loc = sdecl.ptype_loc;
     } in
 
   (* Check constraints *)
@@ -829,11 +831,11 @@ let transl_exn_rebind env loc lid =
   | _ -> raise(Error(loc, Not_an_exception lid))
 
 (* Translate a value declaration *)
-let transl_value_decl env valdecl =
+let transl_value_decl env loc valdecl =
   let ty = Typetexp.transl_type_scheme env valdecl.pval_type in
   match valdecl.pval_prim with
     [] ->
-      { val_type = ty; val_kind = Val_reg }
+      { val_type = ty; val_kind = Val_reg; val_loc = loc }
   | decl ->
       let arity = Ctype.arity ty in
       if arity = 0 then
@@ -843,7 +845,7 @@ let transl_value_decl env valdecl =
       && prim.prim_arity > 5
       && prim.prim_native_name = ""
       then raise(Error(valdecl.pval_type.ptyp_loc, Missing_native_external));
-      { val_type = ty; val_kind = Val_prim prim }
+      { val_type = ty; val_kind = Val_prim prim; val_loc = loc }
 
 (* Translate a "with" constraint -- much simplified version of
     transl_type_decl. *)
@@ -877,6 +879,7 @@ let transl_with_constraint env id row_path orig_decl sdecl =
         end;
       type_variance = [];
       type_newtype_level = None;
+      type_loc = sdecl.ptype_loc;
     }
   in
   begin match row_path with None -> ()
@@ -907,7 +910,9 @@ let abstract_type_decl arity =
       type_private = Public;
       type_manifest = None;
       type_variance = replicate_list (true, true, true) arity;
-      type_newtype_level = None; } in
+      type_newtype_level = None;
+      type_loc = Location.none;
+     } in
   Ctype.end_def();
   generalize_decl decl;
   decl
diff --git a/typing/typedecl.mli b/typing/typedecl.mli
index 7183ada980..25ef97711b 100644
--- a/typing/typedecl.mli
+++ b/typing/typedecl.mli
@@ -27,7 +27,7 @@ val transl_exn_rebind:
     Env.t -> Location.t -> Longident.t -> Path.t * exception_declaration
 
 val transl_value_decl:
-    Env.t -> Parsetree.value_description -> value_description
+    Env.t -> Location.t -> Parsetree.value_description -> value_description
 
 val transl_with_constraint:
     Env.t -> Ident.t -> Path.t option -> type_declaration ->
diff --git a/typing/typemod.ml b/typing/typemod.ml
index 7210eb0fb8..3b14052875 100644
--- a/typing/typemod.ml
+++ b/typing/typemod.ml
@@ -123,7 +123,8 @@ let merge_constraint initial_env loc sg lid constr =
             type_variance =
               List.map (fun (c,n) -> (not n, not c, not c))
               sdecl.ptype_variance;
-	    type_newtype_level = None}
+            type_loc = Location.none;
+	    type_newtype_level = None }
         and id_row = Ident.create (s^"#row") in
         let initial_env = Env.add_type id_row decl_row initial_env in
         let newdecl = Typedecl.transl_with_constraint
@@ -380,7 +381,7 @@ and transl_signature env sg =
     | item :: srem ->
         match item.psig_desc with
         | Psig_value(name, sdesc) ->
-            let desc = Typedecl.transl_value_decl env sdesc in
+            let desc = Typedecl.transl_value_decl env item.psig_loc sdesc in
             let (id, newenv) = Env.enter_value name desc env in
             let rem = transl_sig newenv srem in
             if List.exists (Ident.equal id) (get_values rem) then rem
@@ -809,8 +810,8 @@ and type_structure funct_body anchor env sstr scope =
         (Tstr_value(rec_flag, defs) :: str_rem,
          map_end make_sig_value bound_idents sig_rem,
          final_env)
-    | {pstr_desc = Pstr_primitive(name, sdesc)} :: srem ->
-        let desc = Typedecl.transl_value_decl env sdesc in
+    | {pstr_desc = Pstr_primitive(name, sdesc); pstr_loc = loc} :: srem ->
+        let desc = Typedecl.transl_value_decl env loc sdesc in
         let (id, newenv) = Env.enter_value name desc env in
         let (str_rem, sig_rem, final_env) = type_struct newenv srem in
         (Tstr_primitive(id, desc) :: str_rem,
diff --git a/typing/types.ml b/typing/types.ml
index 044e236c80..ef958501a5 100644
--- a/typing/types.ml
+++ b/typing/types.ml
@@ -87,7 +87,9 @@ module Vars = Meths
 
 type value_description =
   { val_type: type_expr;                (* Type of the value *)
-    val_kind: value_kind }
+    val_kind: value_kind;
+    val_loc: Location.t;
+ }
 
 and value_kind =
     Val_reg                             (* Regular value *)
@@ -146,8 +148,9 @@ type type_declaration =
     type_private: private_flag;
     type_manifest: type_expr option;
     type_variance: (bool * bool * bool) list;
-            (* covariant, contravariant, weakly contravariant *)
-    type_newtype_level: (int * int) option }
+    (* covariant, contravariant, weakly contravariant *)
+    type_newtype_level: (int * int) option;
+    type_loc: Location.t }
 
 and type_kind =
     Type_abstract
diff --git a/typing/types.mli b/typing/types.mli
index e612131042..64ed128479 100644
--- a/typing/types.mli
+++ b/typing/types.mli
@@ -85,7 +85,9 @@ module Vars  : Map.S with type key = string
 
 type value_description =
   { val_type: type_expr;                (* Type of the value *)
-    val_kind: value_kind }
+    val_kind: value_kind;
+    val_loc: Location.t;
+   }
 
 and value_kind =
     Val_reg                             (* Regular value *)
@@ -144,8 +146,9 @@ type type_declaration =
     type_manifest: type_expr option;
     type_variance: (bool * bool * bool) list;
     (* covariant, contravariant, weakly contravariant *)
-    type_newtype_level: (int * int) option }
+    type_newtype_level: (int * int) option;
     (* definition level * expansion level *)
+    type_loc: Location.t }
 
 and type_kind =
     Type_abstract
diff --git a/utils/clflags.ml b/utils/clflags.ml
index 0f7187d8a0..ccf75b00ed 100644
--- a/utils/clflags.ml
+++ b/utils/clflags.ml
@@ -53,6 +53,7 @@ and no_auto_link = ref false            (* -noautolink *)
 and dllpaths = ref ([] : string list)   (* -dllpath *)
 and make_package = ref false            (* -pack *)
 and for_package = ref (None: string option) (* -for-pack *)
+and error_size = ref 500                (* -error-size *)
 let dump_parsetree = ref false          (* -dparsetree *)
 and dump_rawlambda = ref false          (* -drawlambda *)
 and dump_lambda = ref false             (* -dlambda *)
diff --git a/utils/clflags.mli b/utils/clflags.mli
index 7bbd32694c..b089017152 100644
--- a/utils/clflags.mli
+++ b/utils/clflags.mli
@@ -50,6 +50,7 @@ val no_auto_link : bool ref
 val dllpaths : string list ref
 val make_package : bool ref
 val for_package : string option ref
+val error_size : int ref
 val dump_parsetree : bool ref
 val dump_rawlambda : bool ref
 val dump_lambda : bool ref