port to the latest ocaml (2004/06/18)gcaml

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

284 files changed, 11100 insertions, 7267 deletions

diff --git a/Changes b/Changes
index 15545c4aac..a77e018ec9 100644
--- a/Changes
+++ b/Changes
@@ -1,13 +1,101 @@
 Objective Caml 3.08:
 --------------------
 
+(Changes that can break existing programs are marked with a "*"  )
+
+Language features:
+- Support for immediate objects, i.e. objects defined without going
+  through a class.  (Syntax is "object <field and methods> end".)
+
+Type-checking:
+* When typing records, the module path annotation of the first path
+  annotated label now stands for all of the un-annotated labels of
+  the record.
+
+Both compilers:
+- More compact compilation of classes.
+- Much more efficient handling of class definitions inside functors
+  or local modules.
+- Simpler represention for method tables. Objects can now be marshalled
+  between identical programs with the flag Marshal.Closures.
+- Improved error messages for objects and variants.
+- Improved printing of inferred module signatures (toplevel and ocamlc -i).
+  Recursion between type, class, class type and module definitions is now
+  correctly printed.
+- The -pack option now accepts compiled interfaces (.cmi files) in addition
+  to compiled implementations.
+* A compile-time error is signaled if an integer literal exceeds the
+  range of representable integers.
+- Fixed code generation error for "module rec" definitions.
+- The combination of options -c -o sets the name of the generated
+  .cm[iox] files.
+
+Bytecode compiler:
+- Option -output-obj is now compatible with Dynlink and 
+  with embedded toplevels.
+
+Native-code compiler:
+- Division and modulus by zero correctly raise exception Division_by_zero
+  (instead of causing a hardware trap).
+- Improved compilation time for the register allocation phase.
+- The float constant -0.0 was incorrectly treated as +0.0 on some processors.
+- AMD64: fixed bugs in asm glue code for GC invocation and exception raising
+  from C.
+- IA64: fixed incorrect code generated for "expr mod 1".
+- PowerPC: minor performance tweaks for the G4 and G5 processors.
+
+Standard library:
+* Revised handling of NaN floats in polymorphic comparisons.
+  The polymorphic boolean-valued comparisons (=, <, >, etc) now treat
+  NaN as uncomparable, as specified by the IEEE standard.
+  The 3-valued comparison (compare) treats NaN as equal to itself
+  and smaller than all other floats.
+* String-to-integer conversions now fail if the result overflows
+  the range of integers representable in the result type.
+* All array and string access functions now raise
+  Invalid_argument("index out of bounds") when a bounds check fails.
+  In earlier releases, different exceptions were raised
+  in bytecode and native-code.
+- Module Buffer: new functions Buffer.sub, Buffer.nth
+- Module Int32: new functions Int32.bits_of_float, Int32.float_of_bits.
+- Module Map: new functions is_empty, compare, equal.
+- Module Set: new function split.
+* Module Gc: in-order finalisation, new function finalise_release.
+
+Other libraries:
+- The Num library: complete reimplementation of the C/asm lowest
+  layer to work around potential licensing problems.
+  Improved speed on the PowerPC and AMD64 architectures.
+- The Str library: fixed bug in "split" functions with nullable regexps.
+- The Unix library:
+   . Added support for IPv6.
+   . Bug fixes in Unix.closedir.
+   . Allow thread switching on Unix.lockf.
+
 Runtime System:
-- All global identifiers are now prefixed with "caml" to avoid name clashes
-  with other libraries.
+* Name space depollution: all global C identifiers are now prefixed
+  with "caml" to avoid name clashes with other libraries.  This
+  includes the "external" primitives of the standard runtime.
+
+Ports:
+- Windows ports: many improvements in the OCamlWin toplevel application
+  (history, save inputs to file, etc).  Contributed by Christopher A. Watford.
+- Native-code compilation supported for HPPA/Linux. Contributed by Guy Martin.
+- Removed support for MacOS9.  Mac OS 9 is obsolete and the port was not
+  updated since 3.05.
+- Removed ocamlopt support for HPPA/Nextstep.
+
+Ocamllex:
+- #line directives in the input file are now accepted.
+- Added character set concatenation operator "cset1 # cset2".
+
+Ocamlyacc:
+- #line directives in the input file are now accepted.
+
+Camlp4:
+* Support for new-style locations (line numbers, not just character numbers).
+- See camlp4/CHANGES and camlp4/ICHANGES for more info.
 
-Mac OS 9 Port:
-- Removed all MacOS9-specific files.  The Mac OS 9 port is obsolete, it
-  was not updated since 3.05.
 
 Objective Caml 3.07:
 --------------------
diff --git a/Makefile b/Makefile
index e1052ca2fc..e8b6e71b7b 100644
--- a/Makefile
+++ b/Makefile
@@ -635,7 +635,9 @@ checkstack:
 
 # Make MacOS X package
 
-package-macosx: FORCE
+.PHONY: package-macosx
+
+package-macosx:
 	make BINDIR="`pwd`"/package-macosx/root$(BINDIR) \
 	     LIBDIR="`pwd`"/package-macosx/root$(LIBDIR) \
 	     MANDIR="`pwd`"/package-macosx/root$(MANDIR) install
@@ -680,3 +682,5 @@ include .depend
 
 gcamllibrary: ocamlc
 	cd gcamllib; $(MAKE) all
+
+	
\ No newline at end of file
diff --git a/README.win32 b/README.win32
index 96d759e00c..e4c400c2fb 100644
--- a/README.win32
+++ b/README.win32
@@ -149,7 +149,8 @@ The initial port of Caml Special Light (the ancestor of Objective Caml)
 to Windows NT was done by Kevin Gallo at Microsoft Research, who
 kindly contributed his changes to the Caml project.
 
-The graphical user interface for the toplevel is due to Jacob Navia.
+The graphical user interface for the toplevel was initially developed
+by Jacob Navia, then significantly improved by Christopher A. Watford.
 
 ------------------------------------------------------------------------------
 
diff --git a/asmrun/Makefile b/asmrun/Makefile
index 720e3cfbf9..b8034bab43 100644
--- a/asmrun/Makefile
+++ b/asmrun/Makefile
@@ -150,13 +150,6 @@ LINKEDFILES=misc.c freelist.c major_gc.c minor_gc.c memory.c alloc.c array.c \
 clean::
 	rm -f $(LINKEDFILES)
 
-# For HPUX, we can't use gcc as ASPP because it may have been configured with
-# the vendor's assembler
-hppa.o: hppa.S
-	gcc -traditional -E -DSYS_$(SYSTEM) -o hppa.s hppa.S
-	gas -o hppa.o hppa.s || { rm -f hppa.s; exit 2; }
-	rm -f hppa.s
-
 .SUFFIXES: .S .d.o .p.o
 
 .S.o:
diff --git a/asmrun/amd64.S b/asmrun/amd64.S
index eaa24153ee..1288e826a6 100644
--- a/asmrun/amd64.S
+++ b/asmrun/amd64.S
@@ -34,11 +34,11 @@ FUNCTION(caml_call_gc)
         movq    %rax, caml_last_return_address(%rip)
         leaq    8(%rsp), %rax
         movq    %rax, caml_bottom_of_stack(%rip)
+.L105:  
     /* Save caml_young_ptr, caml_exception_pointer */
 	movq	%r15, caml_young_ptr(%rip)
 	movq	%r14, caml_exception_pointer(%rip)
     /* Build array of registers, save it into caml_gc_regs */
-.L105:  
         pushq   %r13
         pushq   %r12
         pushq   %rbp
diff --git a/asmrun/fail.c b/asmrun/fail.c
index 57146b64cb..d00014ef29 100644
--- a/asmrun/fail.c
+++ b/asmrun/fail.c
@@ -79,6 +79,7 @@ void caml_raise_constant(value tag)
   bucket = caml_alloc_small (1, 0);
   Field(bucket, 0) = tag;
   caml_raise(bucket);
+  CAMLnoreturn;
 }
 
 void caml_raise_with_arg(value tag, value arg)
@@ -90,6 +91,7 @@ void caml_raise_with_arg(value tag, value arg)
   Field(bucket, 0) = tag;
   Field(bucket, 1) = arg;
   caml_raise(bucket);
+  CAMLnoreturn;
 }
 
 void caml_raise_with_string(value tag, char *msg)
diff --git a/asmrun/hppa.S b/asmrun/hppa.S
index 713caea666..c8a265e203 100644
--- a/asmrun/hppa.S
+++ b/asmrun/hppa.S
@@ -30,18 +30,18 @@
 #define LOWLABEL(x) RR%x
 #endif
 
-#ifdef SYS_nextstep
-#define G(x) _##x
+#ifdef SYS_linux
+#define G(x) x
 #define CODESPACE .text
-#define CODE_ALIGN 2
+#define CODE_ALIGN 8
 #define EXPORT_CODE(x) .globl x
 #define EXPORT_DATA(x) .globl x
 #define STARTPROC
 #define ENDPROC
-#define LOADHIGH(x) ldil L`x, %r1
-#define LOW(x) R`x
-#define LOADHIGHLABEL(x) ldil L`x, %r1
-#define LOWLABEL(x) R`x
+#define LOADHIGH(x) addil LR%x-$global$, %r27
+#define LOW(x) RR%x-$global$
+#define LOADHIGHLABEL(x) ldil LR%x, %r1
+#define LOWLABEL(x) RR%x
 #endif
 
 #ifdef SYS_hpux
@@ -69,14 +69,15 @@ caml_exception_pointer       .comm 8
 caml_required_size           .comm 8
 #endif
 
-#ifdef SYS_nextstep
-	.comm	G(caml_young_limit), 8
-	.comm	G(caml_young_ptr), 8
-	.comm	G(caml_bottom_of_stack), 8
-	.comm	G(caml_last_return_address), 8
-	.comm	G(caml_gc_regs), 8
-	.comm	G(caml_exception_pointer), 8
-	.comm	G(caml_required_size), 8
+#ifdef SYS_linux
+	.align	8
+	.comm	G(young_limit), 4
+	.comm	G(young_ptr), 4
+	.comm	G(caml_bottom_of_stack), 4
+	.comm	G(caml_last_return_address), 4
+	.comm	G(caml_gc_regs), 4
+	.comm	G(caml_exception_pointer), 4
+	.comm	G(caml_required_size), 4
 #endif
 
 ; Allocation functions
@@ -173,14 +174,8 @@ L100:   ldo     -(64 + 4*32)(%r30), %r31
         fstds,ma %fr30, 8(%r1)
 
 ; Call the garbage collector
-#ifdef SYS_nextstep
-        ldil    L`G(caml_garbage_collection), %r1
-        ble     R`G(caml_garbage_collection)(4, %r1)
-        copy    %r31, %r2
-#else
         bl      G(caml_garbage_collection), %r2
         nop
-#endif
 
 ; Restore all regs used by the code generator
         ldo     -(64 + 4*32)(%r30), %r1
@@ -452,14 +447,8 @@ L103:
 
 ; Re-raise the exception through caml_raise, to clean up local C roots
         ldo     64(%r30), %r30
-#ifdef SYS_nextstep
-        ldil    L`G(caml_raise), %r1
-        ble     R`G(caml_raise)(4, %r1)
-        copy    %r31, %r2
-#else
         bl      G(caml_raise), %r2
         nop
-#endif
         ENDPROC
 
 ; Raise an exception from C
@@ -529,13 +518,8 @@ G(caml_callback3_exn):
 G(caml_ml_array_bound_error):
         STARTPROC
 ; Load address of [caml_array_bound_error] in %r22
-#ifdef SYS_hpux
         ldil    LR%caml_array_bound_error, %r22
         ldo     RR%caml_array_bound_error(%r22), %r22
-#else
-        ldil    L`_caml_array_bound_error, %r22
-        ldo     R`_caml_array_bound_error(%r22), %r22
-#endif
 ; Reserve 48 bytes of stack space and jump to caml_c_call
         b       G(caml_c_call)
 	ldo	48(%r30), %r30	/* in delay slot */
diff --git a/asmrun/i386nt.asm b/asmrun/i386nt.asm
index 9ef28aeffc..583feb7414 100644
--- a/asmrun/i386nt.asm
+++ b/asmrun/i386nt.asm
@@ -18,14 +18,13 @@
 	.386
 	.MODEL FLAT
 
-        EXTERN  _garbage_collection: PROC
-        EXTERN  _mlraise: PROC
+        EXTERN  _caml_garbage_collection: PROC
         EXTERN  _caml_apply2: PROC
         EXTERN  _caml_apply3: PROC
         EXTERN  _caml_program: PROC
-        EXTERN  _array_bound_error: PROC
-        EXTERN  _young_limit: DWORD
-        EXTERN  _young_ptr: DWORD
+        EXTERN  _caml_array_bound_error: PROC
+        EXTERN  _caml_young_limit: DWORD
+        EXTERN  _caml_young_ptr: DWORD
         EXTERN	_caml_bottom_of_stack: DWORD
         EXTERN	_caml_last_return_address: DWORD
         EXTERN	_caml_gc_regs: DWORD
@@ -37,7 +36,7 @@
         PUBLIC  _caml_alloc1
         PUBLIC  _caml_alloc2
         PUBLIC  _caml_alloc3
-        PUBLIC  _caml_alloc
+        PUBLIC  _caml_allocN
 	PUBLIC  _caml_call_gc
 
 _caml_call_gc:
@@ -56,7 +55,7 @@ L105:   push    ebp
         push    eax
         mov     _caml_gc_regs, esp
     ; Call the garbage collector 
-        call	_garbage_collection
+        call	_caml_garbage_collection
     ; Restore all regs used by the code generator 
 	pop     eax
         pop     ebx
@@ -70,10 +69,10 @@ L105:   push    ebp
 
         ALIGN  4
 _caml_alloc1:
-        mov	eax, _young_ptr
+        mov	eax, _caml_young_ptr
         sub	eax, 8
-        mov	_young_ptr, eax
-        cmp	eax, _young_limit
+        mov	_caml_young_ptr, eax
+        cmp	eax, _caml_young_limit
         jb	L100
         ret	
 L100:   mov	eax, [esp]
@@ -85,10 +84,10 @@ L100:   mov	eax, [esp]
 
         ALIGN  4
 _caml_alloc2:
-        mov	eax, _young_ptr
+        mov	eax, _caml_young_ptr
         sub	eax, 12
-        mov	_young_ptr, eax
-        cmp	eax, _young_limit
+        mov	_caml_young_ptr, eax
+        cmp	eax, _caml_young_limit
         jb	L101
         ret	
 L101:   mov	eax, [esp]
@@ -100,10 +99,10 @@ L101:   mov	eax, [esp]
 
         ALIGN  4
 _caml_alloc3:
-        mov	eax, _young_ptr
+        mov	eax, _caml_young_ptr
         sub	eax, 16
-        mov	_young_ptr, eax
-        cmp	eax, _young_limit
+        mov	_caml_young_ptr, eax
+        cmp	eax, _caml_young_limit
         jb	L102
         ret	
 L102:   mov	eax, [esp]
@@ -114,24 +113,24 @@ L102:   mov	eax, [esp]
         jmp     _caml_alloc3
 
         ALIGN  4
-_caml_alloc:
-        sub     eax, _young_ptr         ; eax = size - young_ptr
+_caml_allocN:
+        sub     eax, _caml_young_ptr         ; eax = size - young_ptr
         neg     eax                     ; eax = young_ptr - size
-        cmp     eax, _young_limit
+        cmp     eax, _caml_young_limit
         jb      L103
-        mov     _young_ptr, eax
+        mov     _caml_young_ptr, eax
         ret
-L103:   sub     eax, _young_ptr         ; eax = - size
+L103:   sub     eax, _caml_young_ptr         ; eax = - size
         neg     eax                     ; eax = size
         push    eax                     ; save desired size
-        sub     _young_ptr, eax         ; must update young_ptr
+        sub     _caml_young_ptr, eax         ; must update young_ptr
         mov	eax, [esp+4]
         mov     _caml_last_return_address, eax
         lea     eax, [esp+8]
         mov     _caml_bottom_of_stack, eax
         call    L105
         pop     eax                     ; recover desired size
-        jmp     _caml_alloc
+        jmp     _caml_allocN
 
 ; Call a C function from Caml 
 
@@ -197,9 +196,9 @@ L108:
 
 ; Raise an exception from C 
 
-        PUBLIC  _raise_caml_exception
+        PUBLIC  _caml_raise_exception
         ALIGN  4
-_raise_caml_exception:
+_caml_raise_exception:
         mov	eax, [esp+4]
         mov	esp, _caml_exception_pointer
         pop	_caml_exception_pointer
@@ -207,9 +206,9 @@ _raise_caml_exception:
 
 ; Callback from C to Caml 
 
-        PUBLIC  _callback_exn
+        PUBLIC  _caml_callback_exn
         ALIGN  4
-_callback_exn:
+_caml_callback_exn:
     ; Save callee-save registers 
         push	ebx
         push	esi
@@ -221,9 +220,9 @@ _callback_exn:
         mov	esi, [ebx]      ; code pointer
         jmp     L106
 
-        PUBLIC  _callback2_exn
+        PUBLIC  _caml_callback2_exn
         ALIGN  4
-_callback2_exn:
+_caml_callback2_exn:
     ; Save callee-save registers 
         push	ebx
         push	esi
@@ -236,9 +235,9 @@ _callback2_exn:
         mov	esi, offset _caml_apply2   ; code pointer 
         jmp	L106
 
-        PUBLIC  _callback3_exn
+        PUBLIC  _caml_callback3_exn
         ALIGN	4
-_callback3_exn:
+_caml_callback3_exn:
     ; Save callee-save registers 
         push	ebx
         push	esi
@@ -252,9 +251,9 @@ _callback3_exn:
         mov	esi, offset _caml_apply3   ; code pointer 
         jmp	L106
 
-        PUBLIC  _caml_array_bound_error
+        PUBLIC  _caml_ml_array_bound_error
         ALIGN   4
-_caml_array_bound_error:
+_caml_ml_array_bound_error:
     ; Empty the floating-point stack
         ffree   st(0)
         ffree   st(1)
@@ -265,11 +264,11 @@ _caml_array_bound_error:
         ffree   st(6)
         ffree   st(7)
     ; Branch to array_bound_error
-        jmp     _array_bound_error
+        jmp     _caml_array_bound_error
 
         .DATA
-        PUBLIC  _system__frametable
-_system__frametable LABEL DWORD
+        PUBLIC  _caml_system__frametable
+_caml_system__frametable LABEL DWORD
         DWORD   1               ; one descriptor 
         DWORD   L107            ; return address into callback 
         WORD    -1              ; negative frame size => use callback link 
diff --git a/asmrun/signals.c b/asmrun/signals.c
index 1074ec3acb..efc73ce7e9 100644
--- a/asmrun/signals.c
+++ b/asmrun/signals.c
@@ -41,7 +41,7 @@ extern char * caml_code_area_start, * caml_code_area_end;
 #ifdef _WIN32
 typedef void (*sighandler)(int sig);
 extern sighandler caml_win32_signal(int sig, sighandler action);
-#define signal(sig,act) win32_signal(sig,act)
+#define signal(sig,act) caml_win32_signal(sig,act)
 #endif
 
 #if defined(TARGET_power) && defined(SYS_rhapsody)
@@ -224,24 +224,6 @@ void caml_leave_blocking_section(void)
   caml_async_signal_mode = 0;
 }
 
-#ifdef POSIX_SIGNALS
-static void reraise(int sig, int now)
-{
-  struct sigaction sa;
-  sa.sa_handler = 0;
-  sa.sa_flags = 0;
-  sigemptyset(&sa.sa_mask);
-  sigaction(sig, &sa, 0);
-  /* If the signal was sent using kill() (si_code == 0) or will
-     not recur then raise it here.  Otherwise return.  The
-     offending instruction will be reexecuted and the signal
-     will recur.  */
-  if (now == 1)
-    raise(sig);
-  return;
-}
-#endif
-
 #if defined(TARGET_alpha) || defined(TARGET_mips)
 static void handle_signal(int sig, int code, struct sigcontext * context)
 #elif defined(TARGET_power) && defined(SYS_aix)
diff --git a/boot/ocamlc b/boot/ocamlc
index f5e342fa42..16d71f5c60 100755
--- a/boot/ocamlc
+++ b/boot/ocamlc
diff --git a/boot/ocamllex b/boot/ocamllex
index fc78d62e7f..1de08b81b5 100755
--- a/boot/ocamllex
+++ b/boot/ocamllex
diff --git a/bytecomp/bytegen.ml b/bytecomp/bytegen.ml
index cdc4c9e287..8a8652488c 100644
--- a/bytecomp/bytegen.ml
+++ b/bytecomp/bytegen.ml
@@ -409,20 +409,27 @@ let rec comp_expr env exp sz cont =
             (Kpush :: comp_expr env func (sz + 3 + nargs)
                       (Kapply nargs :: cont1))
         end
-  | Lsend(met, obj, args) ->
+  | Lsend(kind, met, obj, args) ->
+      let args = if kind = Cached then List.tl args else args in
       let nargs = List.length args + 1 in
+      let getmethod, args' =
+        if kind = Self then (Kgetmethod, met::obj::args) else
+        match met with
+          Lconst(Const_base(Const_int n)) -> (Kgetpubmet n, obj::args)
+        | _ -> (Kgetdynmet, met::obj::args)
+      in
       if is_tailcall cont then
-        comp_args env (met::obj::args) sz
-          (Kgetmethod :: Kappterm(nargs, sz + nargs) :: discard_dead_code cont)
+        comp_args env args' sz
+          (getmethod :: Kappterm(nargs, sz + nargs) :: discard_dead_code cont)
       else
         if nargs < 4 then
-          comp_args env (met::obj::args) sz
-            (Kgetmethod :: Kapply nargs :: cont)
+          comp_args env args' sz
+            (getmethod :: Kapply nargs :: cont)
         else begin
           let (lbl, cont1) = label_code cont in
           Kpush_retaddr lbl ::
-          comp_args env (met::obj::args) (sz + 3)
-            (Kgetmethod :: Kapply nargs :: cont1)
+          comp_args env args' (sz + 3)
+            (getmethod :: Kapply nargs :: cont1)
         end
   | Lfunction(kind, params, body) -> (* assume kind = Curried *)
       let lbl = new_label() in
@@ -714,7 +721,7 @@ let rec comp_expr env exp sz cont =
           let info =
             match lam with
               Lapply(_, args)   -> Event_return (List.length args)
-            | Lsend(_, _, args) -> Event_return (List.length args + 1)
+            | Lsend(_, _, _, args) -> Event_return (List.length args + 1)
             | _                 -> Event_other
           in
           let ev = event (Event_after ty) info in
diff --git a/bytecomp/bytelink.ml b/bytecomp/bytelink.ml
index 66f844615c..25bf10453e 100644
--- a/bytecomp/bytelink.ml
+++ b/bytecomp/bytelink.ml
@@ -468,35 +468,6 @@ let build_custom_runtime prim_name exec_name =
       remove_file
         (Filename.chop_suffix (Filename.basename prim_name) ".c" ^ ".obj");
       retcode
-  | "mrc" ->
-      let cppc = "mrc"
-      and libsppc = "\"{sharedlibraries}MathLib\" \
-                     \"{ppclibraries}PPCCRuntime.o\" \
-                     \"{ppclibraries}PPCToolLibs.o\" \
-                     \"{sharedlibraries}StdCLib\" \
-                     \"{ppclibraries}StdCRuntime.o\" \
-                     \"{sharedlibraries}InterfaceLib\""
-      and linkppc = "ppclink -d"
-      and objsppc = extract ".x" (List.rev !Clflags.ccobjs)
-      and q_prim_name = Filename.quote prim_name
-      and q_exec_name = Filename.quote exec_name
-      in
-      Ccomp.run_command (Printf.sprintf "%s %s %s %s -o %s.x"
-        cppc
-        (Clflags.std_include_flag "-i ")
-        (String.concat " " (List.rev_map Filename.quote !Clflags.ccopts))
-        q_prim_name
-        q_prim_name);
-      Ccomp.run_command ("delete -i " ^ q_exec_name);
-      Ccomp.command (Printf.sprintf
-        "%s -t MPST -c 'MPS ' -o %s %s.x %s %s %s"
-        linkppc
-        q_exec_name
-        q_prim_name
-        (String.concat " " (List.map Filename.quote objsppc))
-        (Filename.quote
-            (Filename.concat Config.standard_library "libcamlrun.x"))
-        libsppc)
   | _ -> assert false
 
 let append_bytecode_and_cleanup bytecode_name exec_name prim_name =
diff --git a/bytecomp/bytepackager.ml b/bytecomp/bytepackager.ml
index 450321ac76..57b8371a5b 100644
--- a/bytecomp/bytepackager.ml
+++ b/bytecomp/bytepackager.ml
@@ -72,24 +72,37 @@ let relocate_debug base ev =
 
 (* Read the unit information from a .cmo file. *)
 
-let read_unit_info objfile =
-  let ic = open_in_bin objfile in
-  try
-    let buffer = String.create (String.length Config.cmo_magic_number) in
-    really_input ic buffer 0 (String.length Config.cmo_magic_number);
-    if buffer <> Config.cmo_magic_number then
-      raise(Error(Not_an_object_file objfile));
-    let compunit_pos = input_binary_int ic in
-    seek_in ic compunit_pos;
-    let compunit = (input_value ic : compilation_unit) in
-    if compunit.cu_name
-    <> String.capitalize(Filename.basename(chop_extension_if_any objfile))
-    then raise(Error(Illegal_renaming(objfile, compunit.cu_name)));
-    close_in ic;
-    compunit
-  with x ->
-    close_in ic;
-    raise x
+type pack_member_kind = PM_intf | PM_impl of compilation_unit
+
+type pack_member =
+  { pm_file: string;
+    pm_name: string;
+    pm_kind: pack_member_kind }
+
+let read_member_info file =
+  let name =
+    String.capitalize(Filename.basename(chop_extension_if_any file)) in
+  let kind =
+    if Filename.check_suffix file ".cmo" then begin
+    let ic = open_in_bin file in
+    try
+      let buffer = String.create (String.length Config.cmo_magic_number) in
+      really_input ic buffer 0 (String.length Config.cmo_magic_number);
+      if buffer <> Config.cmo_magic_number then
+        raise(Error(Not_an_object_file file));
+      let compunit_pos = input_binary_int ic in
+      seek_in ic compunit_pos;
+      let compunit = (input_value ic : compilation_unit) in
+      if compunit.cu_name <> name
+      then raise(Error(Illegal_renaming(file, compunit.cu_name)));
+      close_in ic;
+      PM_impl compunit
+    with x ->
+      close_in ic;
+      raise x
+    end else
+      PM_intf in
+  { pm_file = file; pm_name = name; pm_kind = kind }
 
 (* Read the bytecode from a .cmo file.
    Write bytecode to channel [oc].
@@ -97,7 +110,7 @@ let read_unit_info objfile =
    Accumulate relocs, debug info, etc.
    Return size of bytecode. *)
 
-let rename_append_bytecode oc mapping defined ofs (objfile, compunit) =
+let rename_append_bytecode oc mapping defined ofs objfile compunit =
   let ic = open_in_bin objfile in
   try
     Bytelink.check_consistency objfile compunit;
@@ -118,23 +131,37 @@ let rename_append_bytecode oc mapping defined ofs (objfile, compunit) =
     close_in ic;
     raise x
 
-(* Same, for a list of .cmo files.  Return total size of bytecode. *)
+(* Same, for a list of .cmo and .cmi files.
+   Return total size of bytecode. *)
 
 let rec rename_append_bytecode_list oc mapping defined ofs = function
     [] ->
       ofs
-  | ((objfile, compunit) as obj_unit) :: rem ->
-      let size = rename_append_bytecode oc mapping defined ofs obj_unit in
-      rename_append_bytecode_list
-        oc mapping (Ident.create_persistent compunit.cu_name :: defined)
-        (ofs + size) rem
+  | m :: rem ->
+      match m.pm_kind with
+      | PM_intf ->
+          rename_append_bytecode_list oc mapping defined ofs rem
+      | PM_impl compunit ->
+          let size =
+            rename_append_bytecode oc mapping defined ofs 
+                                   m.pm_file compunit in
+          rename_append_bytecode_list
+            oc mapping (Ident.create_persistent m.pm_name :: defined)
+            (ofs + size) rem
 
 (* Generate the code that builds the tuple representing the package module *)
 
-let build_global_target oc target_name mapping pos coercion =
+let build_global_target oc target_name members mapping pos coercion =
+  let components =
+    List.map2
+      (fun m (id1, id2) ->
+        match m.pm_kind with
+        | PM_intf -> None
+        | PM_impl _ -> Some id2)
+      members mapping in
   let lam =
-    Translmod.transl_package (List.map snd mapping)
-                             (Ident.create_persistent target_name) coercion in
+    Translmod.transl_package
+      components (Ident.create_persistent target_name) coercion in
   let instrs =
     Bytegen.compile_implementation target_name lam in
   let rel =
@@ -143,11 +170,11 @@ let build_global_target oc target_name mapping pos coercion =
 
 (* Build the .cmo file obtained by packaging the given .cmo files. *)
 
-let package_object_files objfiles targetfile targetname coercion =
-  let units =
-    List.map (fun f -> (f, read_unit_info f)) objfiles in
+let package_object_files files targetfile targetname coercion =
+  let members =
+    map_left_right read_member_info files in
   let unit_names =
-    List.map (fun (_, cu) -> cu.cu_name) units in
+    List.map (fun m -> m.pm_name) members in
   let mapping =
     List.map
       (fun name ->
@@ -160,8 +187,8 @@ let package_object_files objfiles targetfile targetname coercion =
     let pos_depl = pos_out oc in
     output_binary_int oc 0;
     let pos_code = pos_out oc in
-    let ofs = rename_append_bytecode_list oc mapping [] 0 units in
-    build_global_target oc targetname mapping ofs coercion;
+    let ofs = rename_append_bytecode_list oc mapping [] 0 members in
+    build_global_target oc targetname members mapping ofs coercion;
     let pos_debug = pos_out oc in
     if !Clflags.debug && !events <> [] then
       output_value oc (List.rev !events);
@@ -191,7 +218,7 @@ let package_object_files objfiles targetfile targetname coercion =
 (* The entry point *)
 
 let package_files files targetfile =
-  let objfiles =
+  let files =
     List.map
       (fun f ->
         try find_in_path !Config.load_path f
@@ -201,8 +228,8 @@ let package_files files targetfile =
   let targetcmi = prefix ^ ".cmi" in
   let targetname = String.capitalize(Filename.basename prefix) in
   try
-    let coercion = Typemod.package_units objfiles targetcmi targetname in
-    package_object_files objfiles targetfile targetname coercion
+    let coercion = Typemod.package_units files targetcmi targetname in
+    package_object_files files targetfile targetname coercion
   with x ->
     remove_file targetfile; raise x
 
diff --git a/bytecomp/emitcode.ml b/bytecomp/emitcode.ml
index a2ee15a820..bd56ca6425 100644
--- a/bytecomp/emitcode.ml
+++ b/bytecomp/emitcode.ml
@@ -293,6 +293,8 @@ let emit_instr = function
   | Kisint -> out opISINT
   | Kisout -> out opULTINT
   | Kgetmethod -> out opGETMETHOD
+  | Kgetpubmet tag -> out opGETPUBMET; out_int tag; out_int 0
+  | Kgetdynmet -> out opGETDYNMET
   | Kevent ev -> record_event ev
   | Kstop -> out opSTOP
 
diff --git a/bytecomp/instruct.ml b/bytecomp/instruct.ml
index 81224dde6f..fd13db5d7a 100644
--- a/bytecomp/instruct.ml
+++ b/bytecomp/instruct.ml
@@ -97,6 +97,8 @@ type instruction =
   | Kisint
   | Kisout
   | Kgetmethod
+  | Kgetpubmet of int
+  | Kgetdynmet
   | Kevent of debug_event
   | Kstop
 
diff --git a/bytecomp/instruct.mli b/bytecomp/instruct.mli
index f609d5d94b..fdedd8fd47 100644
--- a/bytecomp/instruct.mli
+++ b/bytecomp/instruct.mli
@@ -116,6 +116,8 @@ type instruction =
   | Kisint
   | Kisout
   | Kgetmethod
+  | Kgetpubmet of int
+  | Kgetdynmet
   | Kevent of debug_event
   | Kstop
 
diff --git a/bytecomp/lambda.ml b/bytecomp/lambda.ml
index 9a2770f10d..7f537ddf2b 100644
--- a/bytecomp/lambda.ml
+++ b/bytecomp/lambda.ml
@@ -115,6 +115,8 @@ type function_kind = Curried | Tupled
 
 type let_kind = Strict | Alias | StrictOpt | Variable
 
+type meth_kind = Self | Public | Cached
+
 type shared_code = (int * int) list
 
 type lambda =
@@ -134,7 +136,7 @@ type lambda =
   | Lwhile of lambda * lambda
   | Lfor of Ident.t * lambda * lambda * direction_flag * lambda
   | Lassign of Ident.t * lambda
-  | Lsend of lambda * lambda * lambda list
+  | Lsend of meth_kind * lambda * lambda * lambda list
   | Levent of lambda * lambda_event
   | Lifused of Ident.t * lambda
 
@@ -225,7 +227,7 @@ let free_variables l =
       freevars e1; freevars e2; freevars e3; fv := IdentSet.remove v !fv
   | Lassign(id, e) ->
       fv := IdentSet.add id !fv; freevars e
-  | Lsend (met, obj, args) ->
+  | Lsend (k, met, obj, args) ->
       List.iter freevars (met::obj::args)
   | Levent (lam, evt) ->
       freevars lam
@@ -309,7 +311,8 @@ let subst_lambda s lam =
   | Lwhile(e1, e2) -> Lwhile(subst e1, subst e2)
   | Lfor(v, e1, e2, dir, e3) -> Lfor(v, subst e1, subst e2, dir, subst e3) 
   | Lassign(id, e) -> Lassign(id, subst e)
-  | Lsend (met, obj, args) -> Lsend (subst met, subst obj, List.map subst args)
+  | Lsend (k, met, obj, args) ->
+      Lsend (k, subst met, subst obj, List.map subst args)
   | Levent (lam, evt) -> Levent (subst lam, evt)
   | Lifused (v, e) -> Lifused (v, subst e)
   and subst_decl (id, exp) = (id, subst exp)
diff --git a/bytecomp/lambda.mli b/bytecomp/lambda.mli
index f862ca8aa1..2c7c56e01e 100644
--- a/bytecomp/lambda.mli
+++ b/bytecomp/lambda.mli
@@ -124,6 +124,8 @@ type let_kind = Strict | Alias | StrictOpt | Variable
       we can discard e if x does not appear in e'
     Variable: the variable x is assigned later in e' *)
 
+type meth_kind = Self | Public | Cached
+
 type shared_code = (int * int) list     (* stack size -> code label *)
 
 type lambda =
@@ -143,7 +145,7 @@ type lambda =
   | Lwhile of lambda * lambda
   | Lfor of Ident.t * lambda * lambda * direction_flag * lambda
   | Lassign of Ident.t * lambda
-  | Lsend of lambda * lambda * lambda list
+  | Lsend of meth_kind * lambda * lambda * lambda list
   | Levent of lambda * lambda_event
   | Lifused of Ident.t * lambda
 
diff --git a/bytecomp/matching.ml b/bytecomp/matching.ml
index 3515538bf4..5a1b19e50b 100644
--- a/bytecomp/matching.ml
+++ b/bytecomp/matching.ml
@@ -376,11 +376,11 @@ let pretty_cases cases =
           prerr_string " " ;
           prerr_string (Format.flush_str_formatter ()))
         ps ;
-(*
+
       prerr_string " -> " ;
       Printlambda.lambda Format.str_formatter l ;
       prerr_string (Format.flush_str_formatter ()) ;
-*)
+
       prerr_endline "")
     cases
 
@@ -778,7 +778,7 @@ let rebuild_nexts arg nexts k =
 (*
   Split a matching.
     Splitting is first directed by or-patterns, then by
-    must test (e.g. constructors)/variable transitions.
+    tests (e.g. constructors)/variable transitions.
 
     The approach is greedy, every split function attempt to
     raise rows as much as possible in the top matrix,
@@ -1778,13 +1778,21 @@ let mk_res get_key env last_choice idef cant_fail ctx =
   fail, klist, jumps
     
 
-(* Aucune optimisation, reflechir apres la release *)
+(*
+     Following two ``failaction'' function compute n, the trap handler
+    to jump to in case of failure of elementary tests
+*)
+
 let mk_failaction_neg partial ctx def = match partial with
 | Partial ->
     begin match def with
     | (_,idef)::_ ->
         Some (Lstaticraise (idef,[])),[],jumps_singleton idef ctx
-    | _ -> assert false
+    | _ ->
+       (* Act as Total, this means
+          If no appropriate default matrix exists,
+          then this switch cannot fail *)
+        None, [], jumps_empty
     end
 | Total ->
     None, [], jumps_empty
@@ -2284,7 +2292,7 @@ and do_compile_matching_pr repr partial ctx arg x =
   prerr_string "COMPILE: " ;
   prerr_endline (match partial with Partial -> "Partial" | Total -> "Total") ;
   prerr_endline "MATCH" ;
-  pretty_ext x ;
+  pretty_precompiled x ;
   prerr_endline "CTX" ;
   pretty_ctx ctx ;
   let (_, jumps) as r =  do_compile_matching repr partial ctx arg x in
diff --git a/bytecomp/matching.mli b/bytecomp/matching.mli
index 763f8fe03a..acbcd6ff8e 100644
--- a/bytecomp/matching.mli
+++ b/bytecomp/matching.mli
@@ -35,3 +35,7 @@ val for_tupled_function:
 exception Cannot_flatten
 
 val flatten_pattern: int -> pattern -> pattern list
+
+val make_test_sequence:
+        lambda option -> primitive -> primitive -> lambda ->
+        (Asttypes.constant * lambda) list -> lambda
diff --git a/bytecomp/meta.ml b/bytecomp/meta.ml
index c4981c95ae..c03523fbcb 100644
--- a/bytecomp/meta.ml
+++ b/bytecomp/meta.ml
@@ -17,6 +17,7 @@ external realloc_global_data : int -> unit = "caml_realloc_global"
 external static_alloc : int -> string = "caml_static_alloc"
 external static_free : string -> unit = "caml_static_free"
 external static_resize : string -> int -> string = "caml_static_resize"
+external static_release_bytecode : string -> int -> unit = "caml_static_release_bytecode" 
 type closure = unit -> Obj.t
 external reify_bytecode : string -> int -> closure = "caml_reify_bytecode"
 external invoke_traced_function : Obj.t -> Obj.t -> Obj.t -> Obj.t
diff --git a/bytecomp/meta.mli b/bytecomp/meta.mli
index de21a36168..3de027f19c 100644
--- a/bytecomp/meta.mli
+++ b/bytecomp/meta.mli
@@ -18,6 +18,7 @@ external global_data : unit -> Obj.t array = "caml_get_global_data"
 external realloc_global_data : int -> unit = "caml_realloc_global"
 external static_alloc : int -> string = "caml_static_alloc"
 external static_free : string -> unit = "caml_static_free"
+external static_release_bytecode : string -> int -> unit = "caml_static_release_bytecode" 
 external static_resize : string -> int -> string = "caml_static_resize"
 type closure = unit -> Obj.t
 external reify_bytecode : string -> int -> closure = "caml_reify_bytecode"
diff --git a/bytecomp/printinstr.ml b/bytecomp/printinstr.ml
index 8b2ba1e8ca..a7c859d847 100644
--- a/bytecomp/printinstr.ml
+++ b/bytecomp/printinstr.ml
@@ -96,6 +96,8 @@ let instruction ppf = function
   | Kisint -> fprintf ppf "\tisint"
   | Kisout -> fprintf ppf "\tisout"
   | Kgetmethod -> fprintf ppf "\tgetmethod"
+  | Kgetpubmet n -> fprintf ppf "\tgetpubmet %i" n
+  | Kgetdynmet -> fprintf ppf "\tgetdynmet"
   | Kstop -> fprintf ppf "\tstop"
   | Kevent ev -> fprintf ppf "\tevent \"%s\" %i" ev.ev_char.Lexing.pos_fname
                                                  ev.ev_char.Lexing.pos_cnum
diff --git a/bytecomp/printlambda.ml b/bytecomp/printlambda.ml
index b8af27831c..4f66ddada4 100644
--- a/bytecomp/printlambda.ml
+++ b/bytecomp/printlambda.ml
@@ -274,10 +274,12 @@ let rec lam ppf = function
        lam hi lam body
   | Lassign(id, expr) ->
       fprintf ppf "@[<2>(assign@ %a@ %a)@]" Ident.print id lam expr
-  | Lsend (met, obj, largs) ->
+  | Lsend (k, met, obj, largs) ->
       let args ppf largs =
         List.iter (fun l -> fprintf ppf "@ %a" lam l) largs in
-      fprintf ppf "@[<2>(send@ %a@ %a%a)@]" lam obj lam met args largs
+      let kind =
+        if k = Self then "self" else if k = Cached then "cache" else "" in
+      fprintf ppf "@[<2>(send%s@ %a@ %a%a)@]" kind lam obj lam met args largs
   | Levent(expr, ev) ->
       let kind = 
        match ev.lev_kind with
diff --git a/bytecomp/simplif.ml b/bytecomp/simplif.ml
index add9ef7cca..ee59cab742 100644
--- a/bytecomp/simplif.ml
+++ b/bytecomp/simplif.ml
@@ -75,8 +75,8 @@ let rec eliminate_ref id = function
            dir, eliminate_ref id e3)
   | Lassign(v, e) ->
       Lassign(v, eliminate_ref id e)
-  | Lsend(m, o, el) ->
-      Lsend(eliminate_ref id m, eliminate_ref id o,
+  | Lsend(k, m, o, el) ->
+      Lsend(k, eliminate_ref id m, eliminate_ref id o,
             List.map (eliminate_ref id) el)
   | Levent(l, ev) ->
       Levent(eliminate_ref id l, ev)
@@ -144,7 +144,7 @@ let simplify_exits lam =
       (* Lalias-bound variables are never assigned, so don't increase
          v's refcount *)
       count l
-  | Lsend(m, o, ll) -> List.iter count (m::o::ll)
+  | Lsend(k, m, o, ll) -> List.iter count (m::o::ll)
   | Levent(l, _) -> count l
   | Lifused(v, l) -> count l
 
@@ -250,7 +250,7 @@ let simplify_exits lam =
   | Lfor(v, l1, l2, dir, l3) ->
       Lfor(v, simplif l1, simplif l2, dir, simplif l3)
   | Lassign(v, l) -> Lassign(v, simplif l)
-  | Lsend(m, o, ll) -> Lsend(simplif m, simplif o, List.map simplif ll)
+  | Lsend(k, m, o, ll) -> Lsend(k, simplif m, simplif o, List.map simplif ll)
   | Levent(l, ev) -> Levent(simplif l, ev)
   | Lifused(v, l) -> Lifused (v,simplif l)
   in
@@ -313,7 +313,7 @@ let simplify_lets lam =
       (* Lalias-bound variables are never assigned, so don't increase
          v's refcount *)
       count l
-  | Lsend(m, o, ll) -> List.iter count (m::o::ll)
+  | Lsend(_, m, o, ll) -> List.iter count (m::o::ll)
   | Levent(l, _) -> count l
   | Lifused(v, l) ->
       if count_var v > 0 then count l
@@ -402,7 +402,7 @@ let simplify_lets lam =
   | Lfor(v, l1, l2, dir, l3) ->
       Lfor(v, simplif l1, simplif l2, dir, simplif l3)
   | Lassign(v, l) -> Lassign(v, simplif l)
-  | Lsend(m, o, ll) -> Lsend(simplif m, simplif o, List.map simplif ll)
+  | Lsend(k, m, o, ll) -> Lsend(k, simplif m, simplif o, List.map simplif ll)
   | Levent(l, ev) -> Levent(simplif l, ev)
   | Lifused(v, l) ->
       if count_var v > 0 then simplif l else lambda_unit
diff --git a/bytecomp/translclass.ml b/bytecomp/translclass.ml
index f0109dae31..59153bd677 100644
--- a/bytecomp/translclass.ml
+++ b/bytecomp/translclass.ml
@@ -22,7 +22,7 @@ open Translcore
 
 (* XXX Rajouter des evenements... *)
 
-type error = Illegal_class_expr
+type error = Illegal_class_expr | Tags of label * label
 
 exception Error of Location.t * error
 
@@ -103,15 +103,18 @@ let transl_super tbl meths inh_methods rem =
 
 let create_object cl obj init =
   let obj' = Ident.create "self" in
-  let (inh_init, obj_init) = init obj' in
+  let (inh_init, obj_init, has_init) = init obj' in
   if obj_init = lambda_unit then
-   (inh_init,
-    Lapply (oo_prim "create_object_and_run_initializers", [obj; Lvar cl]))
+    (inh_init,
+     Lapply (oo_prim (if has_init then "create_object_and_run_initializers"
+                      else"create_object_opt"),
+             [obj; Lvar cl]))
   else begin
    (inh_init,
     Llet(Strict, obj',
             Lapply (oo_prim "create_object_opt", [obj; Lvar cl]),
          Lsequence(obj_init,
+                   if not has_init then Lvar obj' else
                    Lapply (oo_prim "run_initializers_opt",
 			   [obj; Lvar obj'; Lvar cl]))))
   end
@@ -129,20 +132,23 @@ let rec build_object_init cl_table obj params inh_init obj_init cl =
        Lapply(Lvar obj_init, env @ [obj]))
   | Tclass_structure str ->
       create_object cl_table obj (fun obj ->
-        let (inh_init, obj_init) =
+        let (inh_init, obj_init, has_init) =
           List.fold_right
-            (fun field (inh_init, obj_init) ->
+            (fun field (inh_init, obj_init, has_init) ->
                match field with
                  Cf_inher (cl, _, _) ->
                    let (inh_init, obj_init') =
                      build_object_init cl_table (Lvar obj) [] inh_init
                        (fun _ -> lambda_unit) cl
                    in
-                   (inh_init, lsequence obj_init' obj_init)
+                   (inh_init, lsequence obj_init' obj_init, true)
                | Cf_val (_, id, exp) ->
-                   (inh_init, lsequence (set_inst_var obj id exp) obj_init)
-               | Cf_meth _ | Cf_init _ ->
-                   (inh_init, obj_init)
+                   (inh_init, lsequence (set_inst_var obj id exp) obj_init,
+                    has_init)
+               | Cf_meth _ ->
+                   (inh_init, obj_init, has_init)
+               | Cf_init _ ->
+                   (inh_init, obj_init, true)
                | Cf_let (rec_flag, defs, vals) ->
                    (inh_init,
                     Translcore.transl_let rec_flag defs
@@ -150,15 +156,17 @@ let rec build_object_init cl_table obj params inh_init obj_init cl =
                          (fun (id, expr) rem ->
                             lsequence (Lifused(id, set_inst_var obj id expr))
                                       rem)
-                         vals obj_init)))
+                         vals obj_init),
+                    has_init))
             str.cl_field
-            (inh_init, obj_init obj)
+            (inh_init, obj_init obj, false)
         in
         (inh_init,
          List.fold_right
            (fun (id, expr) rem ->
               lsequence (Lifused (id, set_inst_var obj id expr)) rem)
-           params obj_init))
+           params obj_init,
+         has_init))
   | Tclass_fun (pat, vals, cl, partial) ->
       let (inh_init, obj_init) =
         build_object_init cl_table obj (vals @ params) inh_init obj_init cl
@@ -203,16 +211,24 @@ let rec build_object_init_0 cl_table params cl copy_env subst_env top ids =
       (inh_init, lfunction [env] (subst_env env inh_init obj_init))
 
 
-let bind_method tbl public_methods lab id cl_init =
-  if List.mem lab public_methods then
-    Llet(Alias, id, Lvar (meth lab), cl_init)
-  else
-    Llet(StrictOpt, id, Lapply (oo_prim "get_method_label",
-                                [Lvar tbl; transl_label lab]),
-    cl_init)
-
-let bind_methods tbl public_methods meths cl_init =
-  Meths.fold (bind_method tbl public_methods) meths cl_init
+let bind_method tbl lab id cl_init =
+  Llet(StrictOpt, id, Lapply (oo_prim "get_method_label",
+                              [Lvar tbl; transl_label lab]),
+       cl_init)
+
+let bind_methods tbl meths cl_init =
+  let methl = Meths.fold (fun lab id tl -> (lab,id) :: tl) meths [] in
+  let len = List.length methl in
+  if len < 2 then Meths.fold (bind_method tbl) meths cl_init else
+  let ids = Ident.create "ids" in
+  let i = ref len in
+  Llet(StrictOpt, ids,
+       Lapply (oo_prim "get_method_labels",
+               [Lvar tbl; transl_meth_list (List.map fst methl)]),
+       List.fold_right
+         (fun (lab,id) lam ->
+           decr i; Llet(StrictOpt, id, Lprim(Pfield !i, [Lvar ids]), lam))
+         methl cl_init)
 
 let output_methods tbl vals methods lam =
   let lam =
@@ -233,7 +249,7 @@ let rec ignore_cstrs cl =
   | Tclass_apply (cl, _) -> ignore_cstrs cl
   | _ -> cl
 
-let rec build_class_init cla pub_meths cstr inh_init cl_init msubst top cl =
+let rec build_class_init cla cstr inh_init cl_init msubst top cl =
   match cl.cl_desc with
     Tclass_ident path ->
       begin match inh_init with
@@ -255,7 +271,7 @@ let rec build_class_init cla pub_meths cstr inh_init cl_init msubst top cl =
               Cf_inher (cl, vals, meths) ->
                 let cl_init = output_methods cla values methods cl_init in
                 let inh_init, cl_init =
-                  build_class_init cla pub_meths false inh_init
+                  build_class_init cla false inh_init
                     (transl_vals cla false false vals
                        (transl_super cla str.cl_meths meths cl_init))
                     msubst top cl in
@@ -296,18 +312,18 @@ let rec build_class_init cla pub_meths cstr inh_init cl_init msubst top cl =
           (inh_init, cl_init, [], [])
       in
       let cl_init = output_methods cla values methods cl_init in
-      (inh_init, bind_methods cla pub_meths str.cl_meths cl_init)
+      (inh_init, bind_methods cla str.cl_meths cl_init)
   | Tclass_fun (pat, vals, cl, _) ->
       let (inh_init, cl_init) =
-        build_class_init cla pub_meths cstr inh_init cl_init msubst top cl
+        build_class_init cla cstr inh_init cl_init msubst top cl
       in
       let vals = List.map (function (id, _) -> (Ident.name id, id)) vals in
       (inh_init, transl_vals cla true false vals cl_init)
   | Tclass_apply (cl, exprs) ->
-      build_class_init cla pub_meths cstr inh_init cl_init msubst top cl
+      build_class_init cla cstr inh_init cl_init msubst top cl
   | Tclass_let (rec_flag, defs, vals, cl) ->
       let (inh_init, cl_init) =
-        build_class_init cla pub_meths cstr inh_init cl_init msubst top cl
+        build_class_init cla cstr inh_init cl_init msubst top cl
       in
       let vals = List.map (function (id, _) -> (Ident.name id, id)) vals in
       (inh_init, transl_vals cla true false vals cl_init)
@@ -331,7 +347,7 @@ let rec build_class_init cla pub_meths cstr inh_init cl_init msubst top cl =
                  cl_init))
       | _ ->
 	  let core cl_init =
-            build_class_init cla pub_meths true inh_init cl_init msubst top cl
+            build_class_init cla true inh_init cl_init msubst top cl
 	  in
 	  if cstr then core cl_init else
           let (inh_init, cl_init) =
@@ -455,8 +471,8 @@ let rec builtin_meths self env env2 body =
         "var", [Lvar n]
     | Lprim(Pfield n, [Lvar e]) when Ident.same e env ->
         "env", [Lvar env2; Lconst(Const_pointer n)]
-    | Lsend(Lvar n, Lvar s, []) when List.mem s self ->
-        "meth", [Lvar n]
+    | Lsend(Self, met, Lvar s, []) when List.mem s self ->
+        "meth", [met]
     | _ -> raise Not_found
   in
   match body with
@@ -470,9 +486,17 @@ let rec builtin_meths self env env2 body =
   | Lapply(f, [p; arg]) when const_path f && const_path p ->
       let s, args = conv arg in
       ("app_const_"^s, f :: p :: args)
-  | Lsend(Lvar n, Lvar s, [arg]) when List.mem s self ->
+  | Lsend(Self, Lvar n, Lvar s, [arg]) when List.mem s self ->
       let s, args = conv arg in
       ("meth_app_"^s, Lvar n :: args)
+  | Lsend(Self, met, Lvar s, []) when List.mem s self ->
+      ("get_meth", [met])
+  | Lsend(Public, met, arg, []) ->
+      let s, args = conv arg in
+      ("send_"^s, met :: args)
+  | Lsend(Cached, met, arg, [_;_]) ->
+      let s, args = conv arg in
+      ("send_"^s, met :: args)
   | Lfunction (Curried, [x], body) ->
       let rec enter self = function
         | Lprim(Parraysetu _, [Lvar s; Lvar n; Lvar x'])
@@ -512,6 +536,10 @@ module M = struct
     | "meth_app_var"    -> MethAppVar
     | "meth_app_env"    -> MethAppEnv
     | "meth_app_meth"   -> MethAppMeth
+    | "send_const" -> SendConst
+    | "send_var"   -> SendVar
+    | "send_env"   -> SendEnv
+    | "send_meth"  -> SendMeth
     | _ -> assert false
     in Lconst(Const_pointer(Obj.magic tag)) :: args
 end
@@ -604,14 +632,24 @@ let transl_class ids cl_id arity pub_meths cl =
   if not (Translcore.check_recursive_lambda ids obj_init) then
     raise(Error(cl.cl_loc, Illegal_class_expr));
   let (inh_init', cl_init) =
-    build_class_init cla pub_meths true (List.rev inh_init)
-      obj_init msubst top cl
+    build_class_init cla true (List.rev inh_init) obj_init msubst top cl
   in
   assert (inh_init' = []);
   let table = Ident.create "table"
-  and class_init = Ident.create "class_init"
+  and class_init = Ident.create (Ident.name cl_id ^ "_init")
   and env_init = Ident.create "env_init"
   and obj_init = Ident.create "obj_init" in
+  let pub_meths =
+    List.sort
+      (fun s s' -> compare (Btype.hash_variant s) (Btype.hash_variant s'))
+      pub_meths in
+  let tags = List.map Btype.hash_variant pub_meths in
+  let rev_map = List.combine tags pub_meths in
+  List.iter2
+    (fun tag name ->
+      let name' = List.assoc tag rev_map in
+      if name' <> name then raise(Error(cl.cl_loc, Tags(name, name'))))
+    tags pub_meths;
   let ltable table lam =
     Llet(Strict, table,
          Lapply (oo_prim "create_table", [transl_meth_list pub_meths]), lam)
@@ -747,3 +785,6 @@ open Format
 let report_error ppf = function
   | Illegal_class_expr ->
       fprintf ppf "This kind of class expression is not allowed"
+  | Tags (lab1, lab2) ->
+      fprintf ppf "Method labels `%s' and `%s' are incompatible.@ %s"
+        lab1 lab2 "Change one of them."
diff --git a/bytecomp/translclass.mli b/bytecomp/translclass.mli
index a17a0b1178..85d5f74bcd 100644
--- a/bytecomp/translclass.mli
+++ b/bytecomp/translclass.mli
@@ -19,7 +19,7 @@ val dummy_class : lambda -> lambda
 val transl_class :
   Ident.t list -> Ident.t -> int -> string list -> class_expr -> lambda;;
 
-type error = Illegal_class_expr
+type error = Illegal_class_expr | Tags of string * string
 
 exception Error of Location.t * error
 
diff --git a/bytecomp/translcore.ml b/bytecomp/translcore.ml
index 857ac43879..eab9235b0a 100644
--- a/bytecomp/translcore.ml
+++ b/bytecomp/translcore.ml
@@ -573,9 +573,16 @@ let rec transl_exp e =
 and transl_exp0 e =
   match e.exp_desc with
     Texp_ident(path, {val_kind = Val_prim p}) ->
-      if p.prim_name = "%send" then
+      let public_send = p.prim_name = "%send" in
+      if public_send || p.prim_name = "%sendself" then
+        let kind = if public_send then Public else Self in
 	let obj = Ident.create "obj" and meth = Ident.create "meth" in
-	Lfunction(Curried, [obj; meth], Lsend(Lvar meth, Lvar obj, []))
+	Lfunction(Curried, [obj; meth], Lsend(kind, Lvar meth, Lvar obj, []))
+      else if p.prim_name = "%sendcache" then
+	let obj = Ident.create "obj" and meth = Ident.create "meth" in
+        let cache = Ident.create "cache" and pos = Ident.create "pos" in
+	Lfunction(Curried, [obj; meth; cache; pos],
+                  Lsend(Cached, Lvar meth, Lvar obj, [Lvar cache; Lvar pos]))
       else
 	transl_primitive p
   | Texp_ident(path, {val_kind = Val_anc _}) ->
@@ -619,17 +626,26 @@ and transl_exp0 e =
     when List.length args = p.prim_arity
     && List.for_all (fun (arg,_) -> arg <> None) args ->
       let args = List.map (function Some x, _ -> x | _ -> assert false) args in
-      if p.prim_name = "%send" then
-	let obj = transl_exp (List.hd args) in
-	event_after e (Lsend (transl_exp (List.nth args 1), obj, []))
-      else let prim = transl_prim p args in
-      begin match (prim, args) with
-        (Praise, [arg1]) ->
-          Lprim(Praise, [event_after arg1 (transl_exp arg1)])
-      | (_, _) ->
-          if primitive_is_ccall prim
-          then event_after e (Lprim(prim, transl_list args))
-          else Lprim(prim, transl_list args)
+      let argl = transl_list args in
+      let public_send = p.prim_name = "%send"
+        || not !Clflags.native_code && p.prim_name = "%sendcache"in
+      if public_send || p.prim_name = "%sendself" then
+        let kind = if public_send then Public else Self in
+	let obj = List.hd argl in
+	event_after e (Lsend (kind, List.nth argl 1, obj, []))
+      else if p.prim_name = "%sendcache" then
+        match argl with [obj; meth; cache; pos] ->
+          event_after e (Lsend(Cached, meth, obj, [cache; pos]))
+        | _ -> assert false
+      else begin
+        let prim = transl_prim p args in
+        match (prim, args) with
+          (Praise, [arg1]) ->
+            Lprim(Praise, [event_after arg1 (List.hd argl)])
+        | (_, _) ->
+            if primitive_is_ccall prim
+            then event_after e (Lprim(prim, argl))
+            else Lprim(prim, argl)
       end
   | Texp_apply(funct, oargs) ->
       event_after e (transl_apply (transl_exp funct) oargs)
@@ -698,7 +714,7 @@ and transl_exp0 e =
       let ll = transl_list expr_list in
       begin try
         (* Deactivate constant optimization if array is small enough *)
-        if List.length ll <= 5 then raise Not_constant;
+        if List.length ll <= 4 then raise Not_constant;
         let cl = List.map extract_constant ll in
         let master =
           match kind with
@@ -707,7 +723,7 @@ and transl_exp0 e =
           | Pfloatarray ->
               Lconst(Const_float_array(List.map extract_float cl))
           | Pgenarray ->
-              assert false in
+              raise Not_constant in             (* can this really happen? *)
         Lprim(Pccall prim_obj_dup, [master])
       with Not_constant ->
         Lprim(Pmakearray kind, ll)
@@ -732,12 +748,16 @@ and transl_exp0 e =
         (Lifthenelse(transl_exp cond, event_before body (transl_exp body),
                      staticfail))
   | Texp_send(expr, met) ->
-      let met_id =
-        match met with
-          Tmeth_name nm -> Translobj.meth nm
-        | Tmeth_val id  -> id
+      let obj = transl_exp expr in
+      let lam =
+        match met with 
+          Tmeth_val id -> Lsend (Self, Lvar id, obj, [])
+        | Tmeth_name nm ->
+            let (tag, cache) = Translobj.meth obj nm in
+	    let kind = if cache = [] then Public else Cached in
+            Lsend (kind, tag, obj, cache)
       in
-      event_after e (Lsend(Lvar met_id, transl_exp expr, []))
+      event_after e lam
   | Texp_new (cl, _) ->
       Lapply(Lprim(Pfield 0, [transl_path cl]), [lambda_unit])
   | Texp_instvar(path_self, path) ->
@@ -800,10 +820,10 @@ and transl_tupled_cases patl_expr_list =
 and transl_apply lam sargs =
   let lapply funct args =
     match funct with
-      Lsend(lmet, lobj, largs) ->
-        Lsend(lmet, lobj, largs @ args)
-    | Levent(Lsend(lmet, lobj, largs), _) ->
-        Lsend(lmet, lobj, largs @ args)
+      Lsend(k, lmet, lobj, largs) ->
+        Lsend(k, lmet, lobj, largs @ args)
+    | Levent(Lsend(k, lmet, lobj, largs), _) ->
+        Lsend(k, lmet, lobj, largs @ args)
     | Lapply(lexp, largs) ->
         Lapply(lexp, largs @ args)
     | lexp ->
diff --git a/bytecomp/translmod.ml b/bytecomp/translmod.ml
index e2afb162ba..2da6af3926 100644
--- a/bytecomp/translmod.ml
+++ b/bytecomp/translmod.ml
@@ -138,21 +138,21 @@ let init_value modl =
                     [Lvar undef_function_id])
           | _ -> raise Not_found in
         init_v :: init_value_struct env rem
-    | Tsig_type(id, tdecl) :: rem ->
+    | Tsig_type(id, tdecl, _) :: rem ->
         init_value_struct (Env.add_type id tdecl env) rem
     | Tsig_exception(id, edecl) :: rem ->
         transl_exception
           id (Some Predef.path_undefined_recursive_module) edecl ::
         init_value_struct env rem
-    | Tsig_module(id, mty) :: rem ->
+    | Tsig_module(id, mty, _) :: rem ->
         init_value_mod env mty ::
         init_value_struct (Env.add_module id mty env) rem
     | Tsig_modtype(id, minfo) :: rem ->
         init_value_struct (Env.add_modtype id minfo env) rem
-    | Tsig_class(id, cdecl) :: rem ->
+    | Tsig_class(id, cdecl, _) :: rem ->
         Translclass.dummy_class (Lvar undef_function_id) ::
         init_value_struct env rem
-    | Tsig_cltype(id, ctyp) :: rem ->
+    | Tsig_cltype(id, ctyp, _) :: rem ->
         init_value_struct env rem
   in
   try
@@ -550,7 +550,9 @@ let transl_store_implementation module_name (str, restr) =
   primitive_declarations := [];
   let module_id = Ident.create_persistent module_name in
   let (map, prims, size) = build_ident_map restr (defined_idents str) in
-  (size, transl_label_init (transl_store_structure module_id map prims str))
+  transl_store_label_init module_id size
+    (transl_store_structure module_id map prims) str
+  (*size, transl_label_init (transl_store_structure module_id map prims str)*)
 
 (* Compile a toplevel phrase *)
 
@@ -654,15 +656,19 @@ let transl_toplevel_definition str =
 
 (* Compile the initialization code for a packed library *)
 
+let get_component = function
+    None -> Lconst const_unit
+  | Some id -> Lprim(Pgetglobal id, []) 
+
 let transl_package component_names target_name coercion =
   let components =
     match coercion with
       Tcoerce_none ->
-        List.map (fun id -> Lprim(Pgetglobal id, [])) component_names
+        List.map get_component component_names
     | Tcoerce_structure pos_cc_list ->
         let g = Array.of_list component_names in
         List.map
-          (fun (pos, cc) -> apply_coercion cc (Lprim(Pgetglobal g.(pos), [])))
+          (fun (pos, cc) -> apply_coercion cc (get_component g.(pos)))
           pos_cc_list
     | _ ->
         assert false in
@@ -680,7 +686,7 @@ let transl_store_package component_names target_name coercion =
          (fun pos id ->
            Lprim(Psetfield(pos, false),
                  [Lprim(Pgetglobal target_name, []);
-                  Lprim(Pgetglobal id, [])]))
+                  get_component id]))
          0 component_names)
   | Tcoerce_structure pos_cc_list ->
       let id = Array.of_list component_names in
@@ -689,7 +695,7 @@ let transl_store_package component_names target_name coercion =
          (fun dst (src, cc) ->
            Lprim(Psetfield(dst, false),
                  [Lprim(Pgetglobal target_name, []);
-                  apply_coercion cc (Lprim(Pgetglobal id.(src), []))]))
+                  apply_coercion cc (get_component id.(src))]))
          0 pos_cc_list)
   | _ -> assert false
 
diff --git a/bytecomp/translmod.mli b/bytecomp/translmod.mli
index 14ef3bb926..7a2aa5a0f2 100644
--- a/bytecomp/translmod.mli
+++ b/bytecomp/translmod.mli
@@ -22,9 +22,10 @@ val transl_implementation: string -> structure * module_coercion -> lambda
 val transl_store_implementation:
       string -> structure * module_coercion -> int * lambda
 val transl_toplevel_definition: structure -> lambda
-val transl_package: Ident.t list -> Ident.t -> module_coercion -> lambda
+val transl_package: 
+      Ident.t option list -> Ident.t -> module_coercion -> lambda
 val transl_store_package:
-      Ident.t list -> Ident.t -> module_coercion -> int * lambda
+      Ident.t option list -> Ident.t -> module_coercion -> int * lambda
 
 val toplevel_name: Ident.t -> string
 
diff --git a/bytecomp/translobj.ml b/bytecomp/translobj.ml
index ea449202eb..9899e44b3e 100644
--- a/bytecomp/translobj.ml
+++ b/bytecomp/translobj.ml
@@ -13,6 +13,7 @@
 (* $Id$ *)
 
 open Misc
+open Primitive
 open Asttypes
 open Longident
 open Lambda
@@ -44,23 +45,55 @@ let share c =
 
 (* Collect labels *)
 
-let used_methods = ref ([] : (string * Ident.t) list);;
-
-let meth lab =
+let cache_required = ref false
+let method_cache = ref lambda_unit
+let method_count = ref 0
+let method_table = ref []
+
+let meth_tag s = Lconst(Const_base(Const_int(Btype.hash_variant s)))
+
+let next_cache tag =
+  let n = !method_count in
+  incr method_count;
+  (tag, [!method_cache; Lconst(Const_base(Const_int n))])
+
+let rec is_path = function
+    Lvar _ | Lprim (Pgetglobal _, []) | Lconst _ -> true
+  | Lprim (Pfield _, [lam]) -> is_path lam
+  | Lprim ((Parrayrefu _ | Parrayrefs _), [lam1; lam2]) ->
+      is_path lam1 && is_path lam2
+  | _ -> false
+
+let meth obj lab =
+  let tag = meth_tag lab in
+  if not (!cache_required && !Clflags.native_code) then (tag, []) else
+  if not (is_path obj) then next_cache tag else
   try
-    List.assoc lab !used_methods
+    let r = List.assoc obj !method_table in
+    try
+      (tag, List.assoc tag !r)
+    with Not_found ->
+      let p = next_cache tag in
+      r := p :: !r;
+      p
   with Not_found ->
-    let id = Ident.create lab in
-    used_methods := (lab, id)::!used_methods;
-    id
+    let p = next_cache tag in
+    method_table := (obj, ref [p]) :: !method_table;
+    p
 
 let reset_labels () =
   Hashtbl.clear consts;
-  used_methods := []
+  method_count := 0;
+  method_table := []
 
 (* Insert labels *)
 
 let string s = Lconst (Const_base (Const_string s))
+let int n = Lconst (Const_base (Const_int n))
+
+let prim_makearray =
+  { prim_name = "caml_make_vect"; prim_arity = 2; prim_alloc = true;
+    prim_native_name = ""; prim_native_float = false }
 
 let transl_label_init expr =
   let expr =
@@ -68,39 +101,41 @@ let transl_label_init expr =
       (fun c id expr -> Llet(Alias, id, Lconst c, expr))
       consts expr
   in
-  let expr =
-    if !used_methods = [] then expr else
-    let init = Ident.create "new_method" in
-    Llet(StrictOpt, init, oo_prim "new_method",
-         List.fold_right
-           (fun (lab, id) expr ->
-             Llet(StrictOpt, id, Lapply(Lvar init, [string lab]), expr))
-           !used_methods
-           expr)
-  in
   reset_labels ();
   expr
 
+let transl_store_label_init glob size f arg =
+  method_cache := Lprim(Pfield size, [Lprim(Pgetglobal glob, [])]);
+  let expr = f arg in
+  let (size, expr) =
+    if !method_count = 0 then (size, expr) else
+    (size+1,
+     Lsequence(
+     Lprim(Psetfield(size, false),
+	   [Lprim(Pgetglobal glob, []);
+	    Lprim (Pccall prim_makearray, [int !method_count; int 0])]),
+     expr))
+  in
+  (size, transl_label_init expr)
 
 (* Share classes *)
 
 let wrapping = ref false
-let required = ref true
 let top_env = ref Env.empty
 let classes = ref []
 
 let oo_add_class id =
   classes := id :: !classes;
-  (!top_env, !required)
+  (!top_env, !cache_required)
 
 let oo_wrap env req f x =
   if !wrapping then
-    if !required then f x else
-    try required := true; let lam = f x in required := false; lam
-    with exn -> required := false; raise exn
+    if !cache_required then f x else
+    try cache_required := true; let lam = f x in cache_required := false; lam
+    with exn -> cache_required := false; raise exn
   else try
     wrapping := true;
-    required := req;
+    cache_required := req;
     top_env := env;
     classes := [];
     let lambda = f x in
diff --git a/bytecomp/translobj.mli b/bytecomp/translobj.mli
index f0a92b3324..d6e432da5c 100644
--- a/bytecomp/translobj.mli
+++ b/bytecomp/translobj.mli
@@ -17,10 +17,12 @@ open Lambda
 val oo_prim: string -> lambda
 
 val share: structured_constant -> lambda
-val meth: string -> Ident.t
+val meth: lambda -> string -> lambda * lambda list
 
 val reset_labels: unit -> unit
 val transl_label_init: lambda -> lambda
+val transl_store_label_init:
+    Ident.t -> int -> ('a -> lambda) -> 'a -> int * lambda
 
 val oo_wrap: Env.t -> bool -> ('a -> lambda) -> 'a -> lambda
 val oo_add_class: Ident.t -> Env.t * bool
diff --git a/bytecomp/typeopt.ml b/bytecomp/typeopt.ml
index c931519ee4..8838145468 100644
--- a/bytecomp/typeopt.ml
+++ b/bytecomp/typeopt.ml
@@ -87,7 +87,8 @@ let array_element_kind env ty =
 let array_kind_gen ty env =
   let array_ty = Ctype.expand_head env (Ctype.correct_levels ty) in
   match (Ctype.repr array_ty).desc with
-    Tconstr(p, [elt_ty], _) when Path.same p Predef.path_array ->
+    Tconstr(p, [elt_ty], _) | Tpoly({desc = Tconstr(p, [elt_ty], _)}, _)
+    when Path.same p Predef.path_array ->
       array_element_kind env elt_ty
   | _ ->
       (* This can happen with e.g. Obj.field *)
diff --git a/byterun/Makefile b/byterun/Makefile
index dcbcdaee52..34d024961c 100644
--- a/byterun/Makefile
+++ b/byterun/Makefile
@@ -84,6 +84,7 @@ prims.c : primitives
 	 echo '	 0 };') > prims.c
 
 opnames.h : instruct.h
+	LANG=C; \
 	sed -e '/\/\*/d' \
 	    -e '/^#/d' \
 	    -e 's/enum /char * names_of_/' \
diff --git a/byterun/Makefile.nt b/byterun/Makefile.nt
index 506ae7549d..0325cf37fb 100644
--- a/byterun/Makefile.nt
+++ b/byterun/Makefile.nt
@@ -35,7 +35,7 @@ PRIMS=alloc.c array.c compare.c extern.c floats.c gc_ctrl.c hash.c \
   dynlink.c
 
 PUBLIC_INCLUDES=alloc.h callback.h config.h custom.h fail.h intext.h \
-  memory.h misc.h mlvalues.h
+  memory.h misc.h mlvalues.h signals.h compatibility.h
 
 all: ocamlrun.exe libcamlrun.$(A)
 
@@ -68,10 +68,10 @@ prims.c : primitives
 	(echo '#include "mlvalues.h"'; \
 	 echo '#include "prims.h"'; \
 	 sed -e 's/.*/extern value &();/' primitives; \
-	 echo 'c_primitive builtin_cprim[] = {'; \
+	 echo 'c_primitive caml_builtin_cprim[] = {'; \
 	 sed -e 's/.*/	&,/' primitives; \
 	 echo '	 0 };'; \
-	 echo 'char * names_of_builtin_cprim[] = {'; \
+	 echo 'char * caml_names_of_builtin_cprim[] = {'; \
 	 sed -e 's/.*/	"&",/' primitives; \
 	 echo '	 0 };') > prims.c
 
diff --git a/byterun/callback.c b/byterun/callback.c
index f16c4728c9..a960df5448 100644
--- a/byterun/callback.c
+++ b/byterun/callback.c
@@ -32,7 +32,10 @@
 
 CAMLexport int caml_callback_depth = 0;
 
+#ifndef LOCAL_CALLBACK_BYTECODE
 static opcode_t callback_code[] = { ACC, 0, APPLY, 0, POP, 1, STOP };
+#endif 
+
 
 #ifdef THREADED_CODE
 
@@ -57,17 +60,44 @@ CAMLexport value caml_callbackN_exn(value closure, int narg, value args[])
   int i;
   value res;
 
+  /* some alternate bytecode implementations (e.g. a JIT translator)
+     might require that the bytecode is kept in a local variable on
+     the C stack */
+#ifdef LOCAL_CALLBACK_BYTECODE
+  opcode_t local_callback_code[7];
+#endif
+
   Assert(narg + 4 <= 256);
-  Init_callback();
+
   caml_extern_sp -= narg + 4;
   for (i = 0; i < narg; i++) caml_extern_sp[i] = args[i]; /* arguments */
+#ifndef LOCAL_CALLBACK_BYTECODE
   caml_extern_sp[narg] = (value) (callback_code + 4); /* return address */
   caml_extern_sp[narg + 1] = Val_unit;    /* environment */
   caml_extern_sp[narg + 2] = Val_long(0); /* extra args */
   caml_extern_sp[narg + 3] = closure;
+  Init_callback();
   callback_code[1] = narg + 3;
   callback_code[3] = narg;
   res = caml_interprete(callback_code, sizeof(callback_code));
+#else /*have LOCAL_CALLBACK_BYTECODE*/
+  caml_extern_sp[narg] = (value) (local_callback_code + 4); /* return address */
+  caml_extern_sp[narg + 1] = Val_unit;    /* environment */
+  caml_extern_sp[narg + 2] = Val_long(0); /* extra args */
+  caml_extern_sp[narg + 3] = closure;
+  local_callback_code[0] = ACC;
+  local_callback_code[1] = narg + 3;
+  local_callback_code[2] = APPLY;
+  local_callback_code[3] = narg;
+  local_callback_code[4] = POP;
+  local_callback_code[5] =  1;
+  local_callback_code[6] = STOP;
+#ifdef THREADED_CODE
+  caml_thread_code(local_callback_code, sizeof(local_callback_code));
+#endif /*THREADED_CODE*/
+  res = caml_interprete(local_callback_code, sizeof(local_callback_code));
+  caml_release_bytecode(local_callback_code, sizeof(local_callback_code));
+#endif /*LOCAL_CALLBACK_BYTECODE*/
   if (Is_exception_result(res)) caml_extern_sp += narg + 4; /* PR#1228 */
   return res;
 }
diff --git a/byterun/compatibility.h b/byterun/compatibility.h
index 8db284f3fc..f65717b62e 100644
--- a/byterun/compatibility.h
+++ b/byterun/compatibility.h
@@ -48,33 +48,14 @@
 #define alloc_array caml_alloc_array
 #define copy_string_array caml_copy_string_array
 #define convert_flag_list caml_convert_flag_list
-/*      alloc_dummy -> caml_alloc_dummy */
-/*      update_dummy -> caml_update_dummy */
-/* **** asmrun/<arch>.s */
-/*    g caml_alloc -> caml_allocN SP*/
 
 /* **** array.c */
-/*      array_get_addr -> caml_array_get_addr */
-/*      array_get_float -> caml_array_get_float */
-/*      array_get -> caml_array_get */
-/*      array_set_addr -> caml_array_set_addr */
-/*      array_set_float -> caml_array_set_float */
-/*      array_set -> caml_array_set */
-/*      array_unsafe_get_float -> caml_array_unsafe_get_float */
-/*      array_unsafe_get -> caml_array_unsafe_get */
-/*      array_unsafe_set_addr -> caml_array_unsafe_set_addr */
-/*      array_unsafe_set_float -> caml_array_unsafe_set_float */
-/*      array_unsafe_set -> caml_array_unsafe_set */
-/*      make_vect -> caml_make_vect */
-/*      make_array -> caml_make_array */
 
 /* **** backtrace.c */
 #define backtrace_active caml_backtrace_active
 #define backtrace_pos caml_backtrace_pos
 #define backtrace_buffer caml_backtrace_buffer
 #define backtrace_last_exn caml_backtrace_last_exn
-/*    g init_backtrace -> caml_init_backtrace */
-/*    g stash_backtrace -> caml_stash_backtrace */
 #define print_exception_backtrace caml_print_exception_backtrace
 
 /* **** callback.c */
@@ -87,52 +68,22 @@
 #define callback2 caml_callback2
 #define callback3 caml_callback3
 #define callbackN caml_callbackN
-/*      register_named_value -> caml_register_named_value */
 
 /* **** compact.c */
-/*    g compact_heap -> caml_compact_heap */
-/*    g percent_max -> caml_percent_max */
-/*    g compact_heap_maybe -> caml_compact_heap_maybe */
 
 /* **** compare.c */
 #define compare_unordered caml_compare_unordered
-/*      compare -> caml_compare */
-/*      equal -> caml_equal */
-/*      notequal -> caml_notequal */
-/*      lessthan -> caml_lessthan */
-/*      lessequal -> caml_lessequal */
-/*      greaterthan -> caml_greaterthan */
-/*      greaterequal -> caml_greaterequal */
 
 /* **** custom.c */
 #define alloc_custom caml_alloc_custom
 #define register_custom_operations caml_register_custom_operations
-/*    g find_custom_operations -> caml_find_custom_operations */
-/*    g final_custom_operations -> caml_final_custom_operations */
-/*    g init_custom_operations -> caml_init_custom_operations */
 
 /* **** debugger.c */
-/*    g debugger_in_use -> caml_debugger_in_use */
-/*    g event_count -> caml_event_count */
-/*    g debugger_init -> caml_debugger_init */
-/*    g debugger -> caml_debugger */
 
 /* **** dynlink.c */
-/*    g prim_table -> caml_prim_table */
-/*    g prim_name_table -> caml_prim_name_table */
-/*    g shared_libs_path -> caml_shared_libs_path */
-/*    g build_primitive_table -> caml_build_primitive_table */
-/*      dynlink_open_lib -> caml_dynlink_open_lib */
-/*      dynlink_close_lib -> caml_dynlink_close_lib */
-/*      dynlink_lookup_symbol -> caml_dynlink_lookup_symbol */
-/*      dynlink_add_primitive -> caml_dynlink_add_primitive */
-/*      dynlink_get_current_libs -> caml_dynlink_get_current_libs */
 
 /* **** extern.c */
 #define output_val caml_output_val
-/*      output_value -> caml_output_value */
-/*      output_value_to_string -> caml_output_value_to_string */
-/*      output_value_to_buffer -> caml_output_value_to_buffer */
 #define output_value_to_malloc caml_output_value_to_malloc
 #define output_value_to_block caml_output_value_to_block
 #define serialize_int_1 caml_serialize_int_1
@@ -149,7 +100,6 @@
 
 /* **** fail.c */
 #define external_raise caml_external_raise
-/*    g exn_bucket -> caml_exn_bucket */
 #define mlraise caml_raise /*SP*/
 #define raise_constant caml_raise_constant
 #define raise_with_arg caml_raise_with_arg
@@ -166,132 +116,35 @@
 #define raise_sys_blocked_io caml_raise_sys_blocked_io
 #define init_exceptions caml_init_exceptions
 /* **** asmrun/fail.c */
-/*    g raise_caml_exception -> caml_raise_exception SP*/
 /* **** asmrun/<arch>.s */
-/*    g caml_array_bound_error -> caml_ml_array_bound_error SP*/
 
 /* **** finalise.c */
-/*    g final_update -> caml_final_update */
-/*    g final_do_calls -> caml_final_do_calls */
-/*    g final_do_strong_roots -> caml_final_do_strong_roots */
-/*    g final_do_weak_roots -> caml_final_do_weak_roots */
-/*    g final_do_young_roots -> caml_final_do_young_roots */
-/*    g final_empty_young -> caml_final_empty_young */
-/*      final_register -> caml_final_register */
 
 /* **** fix_code.c */
-/*    g start_code -> caml_start_code */
-/*    g code_size -> caml_code_size */
-/*    g saved_code -> caml_saved_code */
-/*    g code_md5 -> caml_code_md5 */
-/*    g load_code -> caml_load_code */
-/*    g fixup_endianness -> caml_fixup_endianness */
-/*    g instr_table -> caml_instr_table */
-/*    g instr_base -> caml_instr_base */
-/*    g thread_code -> caml_thread_code */
-/*    g set_instruction -> caml_set_instruction */
-/*    g is_instruction -> caml_is_instruction */
 
 /* **** floats.c */
 /*#define Double_val caml_Double_val             done in mlvalues.h as needed */
 /*#define Store_double_val caml_Store_double_val done in mlvalues.h as needed */
 #define copy_double caml_copy_double
-/*      format_float -> caml_format_float */
-/*      float_of_string -> caml_float_of_string */
-/*      int_of_float -> caml_int_of_float */
-/*      float_of_int -> caml_float_of_int */
-/*      neg_float -> caml_neg_float */
-/*      abs_float -> caml_abs_float */
-/*      add_float -> caml_add_float */
-/*      sub_float -> caml_sub_float */
-/*      mul_float -> caml_mul_float */
-/*      div_float -> caml_div_float */
-/*      exp_float -> caml_exp_float */
-/*      floor_float -> caml_floor_float */
-/*      fmod_float -> caml_fmod_float */
-/*      frexp_float -> caml_frexp_float */
-/*      ldexp_float -> caml_ldexp_float */
-/*      log_float -> caml_log_float */
-/*      log10_float -> caml_log10_float */
-/*      modf_float -> caml_modf_float */
-/*      sqrt_float -> caml_sqrt_float */
-/*      power_float -> caml_power_float */
-/*      sin_float -> caml_sin_float */
-/*      sinh_float -> caml_sinh_float */
-/*      cos_float -> caml_cos_float */
-/*      cosh_float -> caml_cosh_float */
-/*      tan_float -> caml_tan_float */
-/*      tanh_float -> caml_tanh_float */
-/*      asin_float -> caml_asin_float */
-/*      acos_float -> caml_acos_float */
-/*      atan_float -> caml_atan_float */
-/*      atan2_float -> caml_atan2_float */
-/*      ceil_float -> caml_ceil_float */
-/*      eq_float -> caml_eq_float */
-/*      neq_float -> caml_neq_float */
-/*      le_float -> caml_le_float */
-/*      lt_float -> caml_lt_float */
-/*      ge_float -> caml_ge_float */
-/*      gt_float -> caml_gt_float */
-/*      float_compare -> caml_float_compare */
-/*      classify_float -> caml_classify_float */
-/*      init_ieee_float -> caml_init_ieee_float */
 
 /* **** freelist.c */
-/*    g fl_merge -> caml_fl_merge */
-/*    g fl_cur_size -> caml_fl_cur_size */
-/*    * fl_check *** becomes static */
-/*    g fl_allocate -> caml_fl_allocate */
-/*    g fl_init_merge -> caml_fl_init_merge */
-/*    g fl_reset -> caml_fl_reset */
-/*    g fl_merge_block -> caml_fl_merge_block */
-/*    g fl_add_block -> caml_fl_add_block */
-/*    g make_free_blocks -> caml_make_free_blocks */
 
 /* **** gc_ctrl.c */
-/*    g stat_minor_words -> caml_stat_minor_words */
-/*    g stat_promoted_words -> caml_stat_promoted_words */
-/*    g stat_major-words -> caml_stat_major_words */
-/*    g stat_minor_collections -> caml_stat_minor_collections */
-/*    g stat_major_collections -> caml_stat_major_collections */
-/*    g stat_heap_size -> caml_stat_heap_size */
-/*    g stat_top_heap_size -> caml_stat_top_heap_size */
-/*    g stat_compactions -> caml_stat_compactions */
-/*    g stat_heap_chunks -> caml_stat_heap_chunks */
-/*    g heap_check -> caml_heap_check */
-/*      gc_stat -> caml_gc_stat */
-/*      gc_counters -> caml_gc_counters */
-/*      gc_get -> caml_gc_get */
-/*      gc_set -> caml_gc_set */
-/*      gc_minor -> caml_gc_minor */
-/*      gc_major -> caml_gc_major */
-/*      gc_full_major -> caml_gc_full_major */
-/*      gc_major_slice -> caml_gc_major_slice */
-/*      gc_compaction -> caml_gc_compaction */
 
 /* **** globroots.c */
 #define register_global_root caml_register_global_root
 #define remove_global_root caml_remove_global_root
 
 /* **** hash.c */
-/*      hash_univ_param -> caml_hash_univ_param */
 #define hash_variant caml_hash_variant
 
 /* **** instrtrace.c */
-/*    g icount -> caml_icount */
-/*    g stop_here -> caml_stop_here */
-/*    g trace_flag -> caml_trace_flag */
-/*    g disasm_instr -> caml_disasm_instr */
 
 /* **** intern.c */
 #define input_val caml_input_val
-/*      input_value -> caml_input_value */
 #define input_val_from_string caml_input_val_from_string
-/*      input_value_from_string -> caml_input_value_from_string */
 #define input_value_from_malloc caml_input_value_from_malloc
 #define input_value_from_block caml_input_value_from_block
-/*      marshal_data_size -> caml_marshal_data_size */
-/*    g code_checksum -> caml_code_checksum */
 #define deserialize_uint_1 caml_deserialize_uint_1
 #define deserialize_sint_1 caml_deserialize_sint_1
 #define deserialize_uint_2 caml_deserialize_uint_2
@@ -310,86 +163,15 @@
 #define deserialize_error caml_deserialize_error
 
 /* **** interp.c */
-/*    g interprete -> caml_interprete */
 
 /* **** ints.c */
-/*      int_compare -> caml_int_compare */
-/*      int_of_string -> caml_int_of_string */
-/*      format_int -> caml_format_int */
 #define int32_ops caml_int32_ops
 #define copy_int32 caml_copy_int32
-/*      int32_neg -> caml_int32_neg */
-/*      int32_add -> caml_int32_add */
-/*      int32_sub -> caml_int32_sub */
-/*      int32_mul -> caml_int32_mul */
-/*      int32_div -> caml_int32_div */
-/*      int32_mod -> caml_int32_mod */
-/*      int32_and -> caml_int32_and */
-/*      int32_or -> caml_int32_or */
-/*      int32_xor -> caml_int32_xor */
-/*      int32_shift_left -> caml_int32_shift_left */
-/*      int32_shift_right -> caml_int32_shift_right */
-/*      int32_shift_right_unsigned -> caml_int32_shift_right_unsigned */
-/*      int32_of_int -> caml_int32_of_int */
-/*      int32_to_int -> caml_int32_to_int */
-/*      int32_of_float -> caml_int32_of_float */
-/*      int32_to_float -> caml_int32_to_float */
-/*      int32_compare -> caml_int32_compare */
-/*      int32_format -> caml_int32_format */
-/*      int32_of_string -> caml_int32_of_string */
-/*      int32_bits_of_float -> caml_int32_bits_of_float */
-/*      int32_float_of_bits -> caml_int32_float_of_bits */
 /*#define Int64_val caml_Int64_val   *** done in mlvalues.h as needed */
 #define int64_ops caml_int64_ops
 #define copy_int64 caml_copy_int64
-/*      int64_neg -> caml_int64_neg */
-/*      int64_add -> caml_int64_add */
-/*      int64_sub -> caml_int64_sub */
-/*      int64_mul -> caml_int64_mul */
-/*      int64_div -> caml_int64_div */
-/*      int64_mod -> caml_int64_mod */
-/*      int64_and -> caml_int64_and */
-/*      int64_or -> caml_int64_or */
-/*      int64_xor -> caml_int64_xor */
-/*      int64_shift_left -> caml_int64_shift_left */
-/*      int64_shift_right -> caml_int64_shift_right */
-/*      int64_shift_right_unsigned -> caml_int64_shift_right_unsigned */
-/*      int64_of_int -> caml_int64_of_int */
-/*      int64_to_int -> caml_int64_to_int */
-/*      int64_of_float -> caml_int64_of_float */
-/*      int64_to_float -> caml_int64_to_float */
-/*      int64_of_int32 -> caml_int64_of_int32 */
-/*      int64_to_int32 -> caml_int64_to_int32 */
-/*      int64_of_nativeint -> caml_int64_of_nativeint */
-/*      int64_to_nativeint -> caml_int64_to_nativeint */
-/*      int64_compare -> caml_int64_compare */
-/*      int64_format -> caml_int64_format */
-/*      int64_of_string -> caml_int64_of_string */
-/*      int64_bits_of_float -> caml_int64_bits_of_float */
-/*      int64_float_of_bits -> caml_int64_float_of_bits */
 #define nativeint_ops caml_nativeint_ops
 #define copy_nativeint caml_copy_nativeint
-/*      nativeint_neg -> caml_nativeint_neg */
-/*      nativeint_add -> caml_nativeint_add */
-/*      nativeint_sub -> caml_nativeint_sub */
-/*      nativeint_mul -> caml_nativeint_mul */
-/*      nativeint_div -> caml_nativeint_div */
-/*      nativeint_mod -> caml_nativeint_mod */
-/*      nativeint_and -> caml_nativeint_and */
-/*      nativeint_or -> caml_nativeint_or */
-/*      nativeint_xor -> caml_nativeint_xor */
-/*      nativeint_shift_left -> caml_nativeint_shift_left */
-/*      nativeint_shift_right -> caml_nativeint_shift_right */
-/*      nativeint_shift_right_unsigned -> caml_nativeint_shift_right_unsigned */
-/*      nativeint_of_int -> caml_nativeint_of_int */
-/*      nativeint_to_int -> caml_nativeint_to_int */
-/*      nativeint_of_float -> caml_nativeint_of_float */
-/*      nativeint_to_float -> caml_nativeint_to_float */
-/*      nativeint_of_int32 -> caml_nativeint_of_int32 */
-/*      nativeint_to_int32 -> caml_nativeint_to_int32 */
-/*      nativeint_compare -> caml_nativeint_compare */
-/*      nativeint_format -> caml_nativeint_format */
-/*      nativeint_of_string -> caml_nativeint_of_string */
 
 /* **** io.c */
 #define channel_mutex_free caml_channel_mutex_free
@@ -419,60 +201,18 @@
 #define input_scan_line caml_input_scan_line /*SP*/
 #define finalize_channel caml_finalize_channel
 #define alloc_channel caml_alloc_channel
-/*      caml_open_descriptor_in -> caml_ml_open_descriptor_in SP*/
-/*      caml_open_descriptor_out -> caml_ml_open_descriptor_out SP*/
-/*      caml_out_channels_list -> caml_ml_out_channels_list SP*/
-/*      channel_descriptor -> caml_channel_descriptor */
-/*      caml_close_channel -> caml_ml_close_channel SP*/
-/*      caml_channel_size -> caml_ml_channel_size SP*/
-/*      caml_channel_size_64 -> caml_ml_channel_size_64 SP*/
-/*      caml_set_binary_mode -> caml_ml_set_binary_mode SP*/
-/*      caml_flush_partial -> caml_ml_flush_partial SP*/
-/*      caml_flush -> caml_ml_flush SP*/
-/*      caml_output_char -> caml_ml_output_char SP*/
-/*      caml_output_int -> caml_ml_output_int SP*/
-/*      caml_output_partial -> caml_ml_output_partial SP*/
-/*      caml_output -> caml_ml_output SP*/
-/*      caml_seek_out -> caml_ml_seek_out SP*/
-/*      caml_seek_out_64 -> caml_ml_seek_out_64 SP*/
-/*      caml_pos_out -> caml_ml_pos_out SP*/
-/*      caml_pos_out_64 -> caml_ml_pos_out_64 SP*/
-/*      caml_input_char -> caml_ml_input_char SP*/
-/*      caml_input_int -> caml_ml_input_int SP*/
-/*      caml_input -> caml_ml_input SP*/
-/*      caml_seek_in -> caml_ml_seek_in SP*/
-/*      caml_seek_in_64 -> caml_ml_seek_in_64 SP*/
-/*      caml_pos_in -> caml_ml_pos_in SP*/
-/*      caml_pos_in_64 -> caml_ml_pos_in_64 SP*/
-/*      caml_input_scan_line -> caml_ml_input_scan_line SP*/
 /*#define Val_file_offset caml_Val_file_offset   *** done in io.h as needed */
 /*#define File_offset_val caml_File_offset_val   *** done in io.h as needed */
 
 /* **** lexing.c */
-/*      lex_engine -> caml_lex_engine */
-/*      new_lex_engine -> caml_new_lex_engine */
 
 /* **** main.c */
 /* *** no change */
 
 /* **** major_gc.c */
-/*    g percent_free -> caml_percent_free */
-/*    g major_heap_increment -> caml_major_heap_increment */
 #define heap_start caml_heap_start
 #define heap_end caml_heap_end
 #define page_table caml_page_table
-/*    g page_low -> caml_page_low */
-/*    g page_high -> caml_page_high */
-/*    g gc_sweep_hp -> caml_gc_sweep_hp */
-/*    g gc_phase -> caml_gc_phase */
-/*    g allocated_words -> caml_allocated_words */
-/*    g extra_heap_memory -> caml_extra_heap_memory */
-/*    g fl_size_at_phase_change -> caml_fl_size_at_phase_change */
-/*    g darken -> caml_darken */
-/*    g major_collection_slice -> caml_major_collection_slice */
-/*    g finish_major_cycle -> caml_finish_major_cycle */
-/*    g round_heap_chunk_size -> caml_round_heap_chunk_size */
-/*    g init_major_heap -> caml_init_major_heap */
 
 /* **** md5.c */
 #define md5_string caml_md5_string
@@ -483,13 +223,7 @@
 #define MD5Transform caml_MD5Transform
 
 /* **** memory.c */
-/*    g alloc_for_heap -> caml_alloc_for_heap */
-/*    g free_for_heap -> caml_free_for_heap */
-/*    g add_to_heap -> caml_add_to_heap */
-/*    g shrink_heap -> caml_shrink_heap */
-/*    g allocation_color -> caml_allocation_color */
 #define alloc_shr caml_alloc_shr
-/*    g adjust_gc_speed -> caml_adjust_gc_speed */
 #define initialize caml_initialize
 #define modify caml_modify
 #define stat_alloc caml_stat_alloc
@@ -497,93 +231,45 @@
 #define stat_resize caml_stat_resize
 
 /* **** meta.c */
-/*      get_global_data -> caml_get_global_data */
-/*      reify_bytecode -> caml_reify_bytecode */
-/*      realloc_global -> caml_realloc_global */
-/*      get_current_environment -> caml_get_current_environment */
-/*      invoke_traced_function -> caml_invoke_traced_function */
 
 /* **** minor_gc.c */
-/*    g minor_heap_size -> caml_minor_heap_size */
 #define young_start caml_young_start
 #define young_end caml_young_end
 #define young_ptr caml_young_ptr
 #define young_limit caml_young_limit
 #define ref_table_ptr caml_ref_table_ptr
 #define ref_table_limit caml_ref_table_limit
-/*    g in_minor_collection -> caml_in_minor_collection */
-/*    g set_minor_heap_size -> caml_set_minor_heap_size */
-/*    g oldify_one -> caml_oldify_one */
-/*    g oldify_mopup -> caml_oldify_mopup */
-/*    g empty_minor_heap -> caml_empty_minor_heap */
 #define minor_collection caml_minor_collection
 #define check_urgent_gc caml_check_urgent_gc
-/*    g realloc_ref_table -> caml_realloc_ref_table */
 
 /* **** misc.c */
-/*    g verb_gc -> caml_verb_gc */
-/*    g gc_message -> caml_gc_message */
-/*    g fatal_error -> caml_fatal_error */
-/*    g fatal_error_arg -> caml_fatal_error_arg */
-/*    g fatal_error_arg2 -> caml_fatal_error_arg2 */
-/*    g aligned_malloc -> caml_aligned_malloc */
-/*    g ext_table_init -> caml_ext_table_init */
-/*    g ext_table_add -> caml_ext_table_add */
-/*    g ext_table_free -> caml_ext_table_free */
 
 /* **** obj.c */
-/*      static_alloc -> caml_static_alloc */
-/*      static_free -> caml_static_free */
-/*      static_resize -> caml_static_resize */
-/*      obj_is_block -> caml_obj_is_block */
-/*      obj_tag -> caml_obj_tag */
-/*      obj_set_tag -> caml_obj_set_tag */
-/*      obj_block -> caml_obj_block */
-/*      obj_dup -> caml_obj_dup */
-/*      obj_truncate -> caml_obj_truncate */
-/*      lazy_follow_forward -> caml_lazy_follow_forward */
-/*      lazy_make_forward -> caml_lazy_make_forward */
 
 /* **** parsing.c */
-/*    g parser_trace -> caml_parser_trace */
-/*      parse_engine -> caml_parse_engine */
 
 /* **** prims.c */
-/*    g buitin_cprim -> caml_builtin_cprim */
-/*    g names_of_builtin_cprim -> caml_names_of_builtin_cprim */
 
 /* **** printexc.c */
 #define format_caml_exception caml_format_exception /*SP*/
-/*    g fatal_uncaught_exception -> caml_fatal_uncaught_exception */
 
 /* **** roots.c */
 #define local_roots caml_local_roots
 #define scan_roots_hook caml_scan_roots_hook
-/*    g oldify_local_roots -> caml_oldify_local_roots */
-/*    g darken_all_roots -> caml_darken_all_roots */
-/*    g do_roots -> caml_do_roots */
 #define do_local_roots caml_do_local_roots
 
 /* **** signals.c */
 #define async_signal_mode caml_async_signal_mode
 #define pending_signal caml_pending_signal
 #define something_to_do caml_something_to_do
-/*    g force_major_slice -> caml_force_major_slice */
-/*    g signal_handlers -> caml_signal_handlers */
 #define enter_blocking_section_hook caml_enter_blocking_section_hook
 #define leave_blocking_section_hook caml_leave_blocking_section_hook
 #define async_action_hook caml_async_action_hook
-/*    g process_event -> caml_process_event */
-/*    g execute_signal -> caml_execute_signal */
-/*    * handle_signal *** becomes static */
-/*    g urge_major_slice -> caml_urge_major_slice */
 #define enter_blocking_section caml_enter_blocking_section
 #define leave_blocking_section caml_leave_blocking_section
 #define convert_signal_number caml_convert_signal_number
-/*      install_signal_handler -> caml_install_signal_handler */
 /* **** asmrun/signals.c */
 #define garbage_collection caml_garbage_collection
-/*    g init_signals -> caml_init_signals */
 
 /* **** stacks.c */
 #define stack_low caml_stack_low
@@ -592,110 +278,32 @@
 #define extern_sp caml_extern_sp
 #define trapsp caml_trapsp
 #define trap_barrier caml_trap_barrier
-/*    g global_data -> caml_global_data */
-/*    g max_stack_size -> caml_max_stack_size */
-/*    g init_stack -> caml_init_stack */
-/*    g realloc_stack -> caml_realloc_stack */
-/*      ensure_stack_capacity -> caml_ensure_stack_capacity */
-/*    g change_max_stack_size -> caml_change_max_stack_size */
 
 /* **** startup.c */
 #define atom_table caml_atom_table
-/*    g attempt_open -> caml_attempt_open */
-/*    g read_section_descriptors -> caml_read_section_descriptors */
-/*    g seek_optional_section -> caml_seek_optional_section */
-/*    g seek_section -> caml_seek_section */
 /* **** asmrun/startup.c */
 #define static_data_start caml_static_data_start
 #define static_data_end caml_static_data_end
-/*    g code_area_start -> caml_code_area_start */
-/*    g code_area_end -> caml_code_area_end */
 
 /* **** str.c */
 #define string_length caml_string_length
-/*      ml_string_length -> caml_ml_string_length */
-/*      create_string -> caml_create_string */
-/*      string_get -> caml_string_get */
-/*      string_set -> caml_string_set */
-/*      string_equal -> caml_string_equal */
-/*      string_notequal -> caml_string_notequal */
-/*      string_compare -> caml_string_compare */
-/*      string_lessthan -> caml_string_lessthan */
-/*      string_lessequal -> caml_string_lessequal */
-/*      string_greaterthan -> caml_string_greaterthan */
-/*      string_greaterequal -> caml_string_greaterequal */
-/*      blit_string -> caml_blit_string */
-/*      fill_string -> caml_fill_string */
-/*      is_printable -> caml_is_printable */
-/*      bitvect_test -> caml_bitvect_test */
 
 /* **** sys.c */
 #define sys_error caml_sys_error
 #define sys_exit caml_sys_exit
-/*      sys_open -> caml_sys_open */
-/*      sys_close -> caml_sys_close */
-/*      sys_file_exists -> caml_sys_file_exists */
-/*      sys_remove -> caml_sys_remove */
-/*      sys_chdir -> caml_sys_chdir */
-/*      sys_getcwd -> caml_sys_getcwd */
-/*      sys_getenv -> caml_sys_getenv */
-/*      sys_get_argv -> caml_sys_get_argv */
-/*    g sys_init -> caml_sys_init */
-/*      sys_system_command -> caml_sys_system_command */
-/*      sys_time -> caml_sys_time */
-/*      sys_random_seed -> caml_sys_random_seed */
-/*      sys_get_config -> caml_sys_get_config */
-/*      sys_read_directory -> caml_sys_read_directory */
 
 /* **** terminfo.c */
-/*      terminfo_setup -> caml_terminfo_setup */
-/*      terminfo_backup -> caml_terminfo_backup */
-/*      terminfo_standout -> caml_terminfo_standout*/
-/*      terminfo_resume -> caml_terminfo_resume */
 
 /* **** unix.c  &  win32.c */
-/*    g decompose_path -> caml_decompose_path */
-/*    g search_in_path -> caml_search_in_path */
 #define search_exe_in_path caml_search_exe_in_path
-/*    g search_dll_in_path -> caml_search_dll_in_path */
-/*    g aligned_mmap -> caml_aligned_mmap */
-/*    g aligned_munmap -> caml_aligned_munmap */
-/*    g executable_name -> caml_executable_name */
-/*    g win32_signal -> caml_win32_signal */
-/*    x expand_command_line -> caml_expand_command_line  private CAMLexport */
 
 /* **** weak.c */
-/*    g weak_list_head -> caml_weak_list_head */
-/*    g weak_none -> caml_weak_none */
-/*      weak_create -> caml_weak_create */
-/*      weak_set -> caml_weak_set */
-/*      weak_get -> caml_weak_get */
-/*      weak_get_copy -> caml_weak_get_copy */
-/*      weak_check -> caml_weak_check */
 
 /* **** asmcomp/asmlink.ml */
-/*    g startup -> caml_startup */
-/*    g startup__frametable -> caml_startup_frametable */
-/*    g system__frametable -> caml_system__frametable */
 
 /* **** asmcomp/cmmgen.ml */
-/*    g bucket_* -> caml_bucket_* */
-/*    g globals_map -> caml_globals_map */
-/*    g Match_failure -> caml_exn_Match_failure */
-/*    g Out_of_memory -> caml_exn_Out_of_memory */
-/*    g Invalid_argument -> caml_exn_Invalid_argument */
-/*    g Failure -> caml_exn_Failure */
-/*    g Not_found -> caml_exn_Not_found */
-/*    g Sys_error -> caml_exn_Sys_error */
-/*    g End_of_file -> caml_exn_End_of_file */
-/*    g Division_by_zero -> caml_exn_Division_by_zero */
-/*    g Stack_overflow -> caml_exn_Stack_overflow */
-/*    g Sys_blocked_io -> caml_exn_Sys_blocked_io */
-/*    g Assert_failure -> caml_exn_Assert_failure */
-/*    g Undefined_recursive_module -> caml_exn_Undefined_recursive_module */
 
 /* **** asmcomp/asmlink.ml, asmcomp/cmmgen.ml, asmcomp/compilenv.ml */
-/*    g Module_name -> camlModule_name */
 
 #endif /* CAML_NAME_SPACE */
 #endif /* CAML_COMPATIBILITY_H */
diff --git a/byterun/config.h b/byterun/config.h
index b2e79aa19a..da9612489c 100644
--- a/byterun/config.h
+++ b/byterun/config.h
@@ -74,7 +74,7 @@ typedef struct { uint32 l, h; } uint64, int64;
 /* We use threaded code interpretation if the compiler provides labels
    as first-class values (GCC 2.x). */
 
-#if defined(__GNUC__) && __GNUC__ >= 2 && !defined(DEBUG) && !defined (SHRINKED_GNUC)
+#if defined(__GNUC__) && __GNUC__ >= 2 && !defined(DEBUG) && !defined (SHRINKED_GNUC) && !defined(CAML_JIT)
 #define THREADED_CODE
 #endif
 
diff --git a/byterun/exec.h b/byterun/exec.h
index 56609573e6..1abfa455c3 100644
--- a/byterun/exec.h
+++ b/byterun/exec.h
@@ -56,7 +56,7 @@ struct exec_trailer {
 
 /* Magic number for this release */
 
-#define EXEC_MAGIC "Caml1999X007"
+#define EXEC_MAGIC "Caml1999X008"
 
 
 #endif /* CAML_EXEC_H */
diff --git a/byterun/extern.c b/byterun/extern.c
index 2faeb9e853..85a549539b 100644
--- a/byterun/extern.c
+++ b/byterun/extern.c
@@ -332,15 +332,17 @@ static void extern_rec(value v)
       break;
     }
     case Abstract_tag:
-      extern_invalid_argument("output_value: abstract value");
+      extern_invalid_argument("output_value: abstract value (Abstract)");
       break;
     case Infix_tag:
       writecode32(CODE_INFIXPOINTER, Infix_offset_hd(hd));
       extern_rec(v - Infix_offset_hd(hd));
       break;
+    /* Use default case for objects
     case Object_tag:
       extern_invalid_argument("output_value: object value");
       break;
+    */
     case Custom_tag: {
       unsigned long sz_32, sz_64;
       char * ident = Custom_ops_val(v)->identifier;
@@ -348,7 +350,7 @@ static void extern_rec(value v)
                         unsigned long * wsize_64)
         = Custom_ops_val(v)->serialize;
       if (serialize == NULL) 
-        extern_invalid_argument("output_value: abstract value");
+        extern_invalid_argument("output_value: abstract value (Custom)");
       Write(CODE_CUSTOM);
       writeblock(ident, strlen(ident) + 1);
       Custom_ops_val(v)->serialize(v, &sz_32, &sz_64);
@@ -383,7 +385,7 @@ static void extern_rec(value v)
     writeblock((char *) caml_code_checksum(), 16);
     return;
   }
-  extern_invalid_argument("output_value: abstract value");
+  extern_invalid_argument("output_value: abstract value (outside heap)");
 }
 
 enum { NO_SHARING = 1, CLOSURES = 2 };
@@ -565,13 +567,15 @@ CAMLexport void caml_serialize_block_1(void * data, long len)
 
 CAMLexport void caml_serialize_block_2(void * data, long len)
 {
-  unsigned char * p;
-  char * q;
   if (extern_ptr + 2 * len > extern_limit) resize_extern_block(2 * len);
 #ifndef ARCH_BIG_ENDIAN
-  for (p = data, q = extern_ptr; len > 0; len--, p += 2, q += 2)
-    Reverse_16(q, p);
-  extern_ptr = q;
+  {
+    unsigned char * p;
+    char * q;
+    for (p = data, q = extern_ptr; len > 0; len--, p += 2, q += 2)
+      Reverse_16(q, p);
+    extern_ptr = q;
+  }
 #else
   memmove(extern_ptr, data, len * 2);
   extern_ptr += len * 2;
@@ -580,13 +584,15 @@ CAMLexport void caml_serialize_block_2(void * data, long len)
 
 CAMLexport void caml_serialize_block_4(void * data, long len)
 {
-  unsigned char * p;
-  char * q;
   if (extern_ptr + 4 * len > extern_limit) resize_extern_block(4 * len);
 #ifndef ARCH_BIG_ENDIAN
-  for (p = data, q = extern_ptr; len > 0; len--, p += 4, q += 4)
-    Reverse_32(q, p);
-  extern_ptr = q;
+  {
+    unsigned char * p;
+    char * q;
+    for (p = data, q = extern_ptr; len > 0; len--, p += 4, q += 4)
+      Reverse_32(q, p);
+    extern_ptr = q;
+  }
 #else
   memmove(extern_ptr, data, len * 4);
   extern_ptr += len * 4;
@@ -595,13 +601,15 @@ CAMLexport void caml_serialize_block_4(void * data, long len)
 
 CAMLexport void caml_serialize_block_8(void * data, long len)
 {
-  unsigned char * p;
-  char * q;
   if (extern_ptr + 8 * len > extern_limit) resize_extern_block(8 * len);
 #ifndef ARCH_BIG_ENDIAN
-  for (p = data, q = extern_ptr; len > 0; len--, p += 8, q += 8)
-    Reverse_64(q, p);
-  extern_ptr = q;
+  {
+    unsigned char * p;
+    char * q;
+    for (p = data, q = extern_ptr; len > 0; len--, p += 8, q += 8)
+      Reverse_64(q, p);
+    extern_ptr = q;
+  }
 #else
   memmove(extern_ptr, data, len * 8);
   extern_ptr += len * 8;
diff --git a/byterun/fail.c b/byterun/fail.c
index d785d98f31..64d766fe4f 100644
--- a/byterun/fail.c
+++ b/byterun/fail.c
@@ -49,6 +49,7 @@ CAMLexport void caml_raise_constant(value tag)
   bucket = caml_alloc_small (1, 0);
   Field(bucket, 0) = tag;
   caml_raise(bucket);
+  CAMLnoreturn;
 }
 
 CAMLexport void caml_raise_with_arg(value tag, value arg)
@@ -60,6 +61,7 @@ CAMLexport void caml_raise_with_arg(value tag, value arg)
   Field(bucket, 0) = tag;
   Field(bucket, 1) = arg;
   caml_raise(bucket);
+  CAMLnoreturn;
 }
 
 CAMLexport void caml_raise_with_string(value tag, char *msg)
@@ -69,6 +71,7 @@ CAMLexport void caml_raise_with_string(value tag, char *msg)
 
   vmsg = caml_copy_string(msg);
   caml_raise_with_arg(tag, vmsg);
+  CAMLnoreturn;
 }
 
 CAMLexport void caml_failwith (char *msg)
diff --git a/byterun/finalise.c b/byterun/finalise.c
index 6b955d9c59..76c2d43d49 100644
--- a/byterun/finalise.c
+++ b/byterun/finalise.c
@@ -27,31 +27,61 @@ struct final {
 };
 
 static struct final *final_table = NULL;
-static unsigned long old = 0, young = 0, active = 0, size = 0;
+static unsigned long old = 0, young = 0, size = 0;
 /* [0..old) : finalisable set
    [old..young) : recent set
-   [young..active) : free space
-   [active..size) : finalising set
+   [young..size) : free space
 */
 
-/* Find white finalisable values, darken them, and put them in the
-   finalising set.
+struct to_do {
+  struct to_do *next;
+  int size;
+  struct final item[1];  /* variable size */
+};
+
+static struct to_do *to_do_hd = NULL;
+static struct to_do *to_do_tl = NULL;
+
+static void alloc_to_do (int size)
+{
+  struct to_do *result = malloc (sizeof (struct to_do)
+                                 + size * sizeof (struct final));
+  if (result == NULL) caml_fatal_error ("out of memory");
+  result->next = NULL;
+  result->size = size;
+  if (to_do_tl == NULL){
+    to_do_hd = result;
+    to_do_tl = result;
+  }else{
+    Assert (to_do_tl->next == NULL);
+    to_do_tl->next = result;
+    to_do_tl = result;
+  }
+}
+
+/* Find white finalisable values, put them in the finalising set, and
+   darken them.
    The recent set is empty.
 */
 void caml_final_update (void)
 {
-  unsigned long i;
-  unsigned long oldactive = active;
+  unsigned long i, j, k;
+  unsigned long todo_count = 0;
   
   Assert (young == old);
-  Assert (young <= active);
+  for (i = 0; i < old; i++){
+    Assert (Is_block (final_table[i].val));
+    Assert (Is_in_heap (final_table[i].val));
+    if (Is_white_val (final_table[i].val)) ++ todo_count;
+  }
+
+  alloc_to_do (todo_count);
+  j = k = 0;
   for (i = 0; i < old; i++){
   again:
     Assert (Is_block (final_table[i].val));
     Assert (Is_in_heap (final_table[i].val));
     if (Is_white_val (final_table[i].val)){
-      struct final f;
-
       if (Tag_val (final_table[i].val) == Forward_tag){
         value fv = Forward_val (final_table[i].val);
         if (Is_block (fv) && (Is_young (fv) || Is_in_heap (fv))
@@ -65,31 +95,40 @@ void caml_final_update (void)
           }
         }
       }
-      f = final_table[i];
-      final_table[i] = final_table[--old];
-      final_table[--active] = f;
-      -- i;
+      to_do_tl->item[k++] = final_table[i];
+    }else{
+      final_table[j++] = final_table[i];
     }
   }
-  young = old;
-  for (i = active; i < oldactive; i++) caml_darken (final_table[i].val, NULL);
+  old = young = j;
+  to_do_tl->size = k;
+  for (i = 0; i < k; i++) caml_darken (to_do_tl->item[i++].val, NULL);
 }
 
+static int running_finalisation_function = 0;
+
 /* Call the finalisation functions for the finalising set.
    Note that this function must be reentrant.
 */
 void caml_final_do_calls (void)
 {
   struct final f;
-  
-  Assert (active <= size);
-  if (active < size){
-    caml_gc_message (0x80, "Calling finalisation functions.\n", 0);
-    while (active < size){
-      f = final_table[active++];
-      caml_callback (f.fun, f.val);
-    }
-    caml_gc_message (0x80, "Done calling finalisation functions.\n", 0);
+
+  if (running_finalisation_function) return;
+
+  while (to_do_hd != NULL && to_do_hd->size == 0){
+    to_do_hd = to_do_hd->next;
+    if (to_do_hd == NULL) to_do_tl = NULL;
+  }
+  if (to_do_hd != NULL){
+    Assert (to_do_hd->size > 0);
+    -- to_do_hd->size;
+    f = to_do_hd->item[to_do_hd->size];
+    caml_gc_message (0x80, "Calling finalisation function.\n", 0);
+    running_finalisation_function = 1;
+    caml_callback (f.fun, f.val);
+    running_finalisation_function = 0;
+    caml_gc_message (0x80, "Return from finalisation function.\n", 0);
   }
 }
 
@@ -105,14 +144,16 @@ void caml_final_do_calls (void)
 void caml_final_do_strong_roots (scanning_action f)
 {
   unsigned long i;
+  struct to_do *todo;
 
   Assert (old == young);
-  Assert (young <= active);
-  Assert (active <= size);
   for (i = 0; i < old; i++) Call_action (f, final_table[i].fun);
-  for (i = active; i < size; i++){
-    Call_action (f, final_table[i].fun);
-    Call_action (f, final_table[i].val);
+  
+  for (todo = to_do_hd; todo != NULL; todo = todo->next){
+    for (i = 0; i < todo->size; i++){
+      Call_action (f, todo->item[i].fun);
+      Call_action (f, todo->item[i].val);
+    }
   }
 }
 
@@ -159,29 +200,22 @@ CAMLprim value caml_final_register (value f, value v)
   }
 
   Assert (old <= young);
-  Assert (young <= active);
-  Assert (active <= size);
   
-  if (young >= active){
+  if (young >= size){
     if (final_table == NULL){
       unsigned long new_size = 30;
       final_table = caml_stat_alloc (new_size * sizeof (struct final));
       Assert (old == 0);
       Assert (young == 0);
-      active = size = new_size;
+      size = new_size;
     }else{
       unsigned long new_size = size * 2;
-      unsigned long i;
       final_table = caml_stat_resize (final_table,
                                       new_size * sizeof (struct final));
-      for (i = size-1; i >= active; i--){
-        final_table[i + new_size - size] = final_table[i];
-      }
-      active += new_size - size;
       size = new_size;
     }
   }
-  Assert (young < active);
+  Assert (young < size);
   final_table[young].fun = f;
   if (Tag_val (v) == Infix_tag) v -= Infix_offset_val (v);
   final_table[young].val = v;
@@ -189,3 +223,9 @@ CAMLprim value caml_final_register (value f, value v)
 
   return Val_unit;
 }
+
+CAMLprim value caml_final_release (value unit)
+{
+  running_finalisation_function = 0;
+  return Val_unit;
+}
diff --git a/byterun/fix_code.c b/byterun/fix_code.c
index 470ae825e1..b626f2cb07 100644
--- a/byterun/fix_code.c
+++ b/byterun/fix_code.c
@@ -113,7 +113,7 @@ void caml_thread_code (code_t code, asize_t len)
   l[APPTERM] = l[CLOSURE] = l[PUSHGETGLOBALFIELD] =
   l[GETGLOBALFIELD] = l[MAKEBLOCK] = l[C_CALLN] =
   l[BEQ] = l[BNEQ] = l[BLTINT] = l[BLEINT] = l[BGTINT] = l[BGEINT] =
-  l[BULTINT] = l[BUGEINT] = 2;
+  l[BULTINT] = l[BUGEINT] = l[GETPUBMET] = 2;
   len /= sizeof(opcode_t);
   for (p = code; p < code + len; /*nothing*/) {
     opcode_t instr = *p;
diff --git a/byterun/gc_ctrl.c b/byterun/gc_ctrl.c
index b262bbd9b2..f31ef1de88 100644
--- a/byterun/gc_ctrl.c
+++ b/byterun/gc_ctrl.c
@@ -434,6 +434,7 @@ CAMLprim value caml_gc_compaction(value v)
   caml_finish_major_cycle ();
   caml_finish_major_cycle ();
   caml_compact_heap ();
+  caml_final_do_calls ();
   return Val_unit;
 }
 
diff --git a/byterun/instrtrace.c b/byterun/instrtrace.c
index aba9787490..03260b41e3 100644
--- a/byterun/instrtrace.c
+++ b/byterun/instrtrace.c
@@ -18,11 +18,15 @@
 #ifdef DEBUG
 
 #include <stdio.h>
+#include <string.h>
+#include <ctype.h>
+
 #include "instruct.h"
 #include "misc.h"
 #include "mlvalues.h"
 #include "opnames.h"
 #include "prims.h"
+#include "stacks.h"
 
 extern code_t caml_start_code;
 
@@ -74,4 +78,196 @@ void caml_disasm_instr(pc)
   fflush (stdout);
 }
 
+
+
+
+char *
+caml_instr_string (code_t pc)
+{
+  static char buf[96];
+  char nambuf[36];
+  int instr = *pc;
+  char *nam = 0;
+  memset (buf, 0, sizeof (buf));
+#define bufprintf(Fmt,...) snprintf(buf,sizeof(buf)-1,Fmt,##__VA_ARGS__)
+  nam = (instr < 0 || instr > STOP)
+    ? (snprintf (nambuf, sizeof (nambuf), "???%d", instr), nambuf)
+    : names_of_instructions[instr];
+  pc++;
+  switch (instr) {
+    /* Instructions with one integer operand */
+  case PUSHACC:
+  case ACC:
+  case POP:
+  case ASSIGN:
+  case PUSHENVACC:
+  case ENVACC:
+  case PUSH_RETADDR:
+  case APPLY:
+  case APPTERM1:
+  case APPTERM2:
+  case APPTERM3:
+  case RETURN:
+  case GRAB:
+  case PUSHGETGLOBAL:
+  case GETGLOBAL:
+  case SETGLOBAL:
+  case PUSHATOM:
+  case ATOM:
+  case MAKEBLOCK1:
+  case MAKEBLOCK2:
+  case MAKEBLOCK3:
+  case MAKEFLOATBLOCK:
+  case GETFIELD:
+  case SETFIELD:
+  case GETFLOATFIELD:
+  case SETFLOATFIELD:
+  case BRANCH:
+  case BRANCHIF:
+  case BRANCHIFNOT:
+  case PUSHTRAP:
+  case CONSTINT:
+  case PUSHCONSTINT:
+  case OFFSETINT:
+  case OFFSETREF:
+  case OFFSETCLOSURE:
+  case PUSHOFFSETCLOSURE:
+    bufprintf ("%s %d", nam, pc[0]);
+    break;
+    /* Instructions with two operands */
+  case APPTERM:
+  case CLOSURE:
+  case CLOSUREREC:
+  case PUSHGETGLOBALFIELD:
+  case GETGLOBALFIELD:
+  case MAKEBLOCK:
+  case BEQ:
+  case BNEQ:
+  case BLTINT:
+  case BLEINT:
+  case BGTINT:
+  case BGEINT:
+  case BULTINT:
+  case BUGEINT:
+    bufprintf ("%s %d, %d", nam, pc[0], pc[1]);
+    break;
+  case SWITCH:
+    bufprintf ("SWITCH sz%#lx=%ld::ntag%ld nint%ld",
+	       (long) pc[0], (long) pc[0], (unsigned long) pc[0] >> 16,
+	       (unsigned long) pc[0] & 0xffff);
+    break;
+    /* Instructions with a C primitive as operand */
+  case C_CALLN:
+    bufprintf ("%s %d,", nam, pc[0]);
+    pc++;
+    /* fallthrough */
+  case C_CALL1:
+  case C_CALL2:
+  case C_CALL3:
+  case C_CALL4:
+  case C_CALL5:
+    if (pc[0] < 0 || pc[0] >= caml_prim_name_table.size)
+      bufprintf ("%s unknown primitive %d", nam, pc[0]);
+    else
+      bufprintf ("%s %s", nam, (char *) caml_prim_name_table.contents[pc[0]]);
+    break;
+  default:
+    bufprintf ("%s", nam);
+    break;
+  };
+  return buf;
+}
+
+
+void
+caml_trace_value_file (value v, code_t prog, int proglen, FILE * f)
+{
+  int i;
+  fprintf (f, "%#lx", v);
+  if (!v)
+    return;
+  if (Is_atom (v))
+    fprintf (f, "=atom%ld", v - Atom (0));
+  else if (prog && v % sizeof (int) == 0
+	   && (code_t) v >= prog
+	   && (code_t) v < (code_t) ((char *) prog + proglen))
+    fprintf (f, "=code@%d", (code_t) v - prog);
+  else if (Is_long (v))
+    fprintf (f, "=long%ld", Long_val (v));
+  else if ((void*)v >= (void*)caml_stack_low 
+	   && (void*)v < (void*)caml_stack_high)
+    fprintf (f, "=stack_%d", (long*)caml_stack_high - (long*)v);
+  else if (Is_block (v)) {
+    int s = Wosize_val (v);
+    int tg = Tag_val (v);
+    int l = 0;
+    switch (tg) {
+    case Closure_tag:
+      fprintf (f, "=closure[s%d,cod%d]", s, (code_t) (Code_val (v)) - prog);
+      goto displayfields;
+    case String_tag:
+      l = caml_string_length (v);
+      fprintf (f, "=string[s%dL%d]'", s, l);
+      for (i = 0; i < ((l>0x1f)?0x1f:l) ; i++) {
+	if (isprint (Byte (v, i)))
+	  putc (Byte (v, i), f);
+	else
+	  putc ('?', f);
+      };
+      fprintf (f, "'");
+      goto displayfields;
+    case Double_tag:
+      fprintf (f, "=float[s%d]=%g", s, Double_val (v));
+      goto displayfields;
+    case Double_array_tag:
+      fprintf (f, "=floatarray[s%d]", s);
+      for (i = 0; i < ((s>0xf)?0xf:s); i++)
+	fprintf (f, " %g", Double_field (v, i));
+      goto displayfields;
+    case Abstract_tag:
+      fprintf (f, "=abstract[s%d]", s);
+      goto displayfields;
+    case Custom_tag:
+      fprintf (f, "=custom[s%d]", s);
+      goto displayfields;
+    default:
+      fprintf (f, "=block<T%d/s%d>", tg, s);
+    displayfields:
+      if (s > 0)
+	fputs ("=(", f);
+      for (i = 0; i < s; i++) {
+	if (i > 20) {
+	  fputs ("....", f);
+	  break;
+	};
+	if (i > 0)
+	  putc (' ', f);
+	fprintf (f, "%#lx", Field (v, i));
+      };
+      if (s > 0)
+	putc (')', f);
+    };
+  }
+}
+
+// added by Basile
+void
+caml_trace_accu_sp_file (value accu, value * sp, code_t prog, int proglen,
+			 FILE * f)
+{
+  int i;
+  value *p;
+  fprintf (f, "accu=");
+  caml_trace_value_file (accu, prog, proglen, f);
+  fprintf (f, "\n sp=%#lx @%d:", (long) sp, caml_stack_high - sp);
+  for (p = sp, i = 0; i < 12 + (1 << caml_trace_flag) && p < caml_stack_high;
+       p++, i++) {
+    fprintf (f, "\n[%d] ", caml_stack_high - p);
+    caml_trace_value_file (*p, prog, proglen, f);
+  };
+  putc ('\n', f);
+  fflush (f);
+}
+
 #endif /* DEBUG */
+/* eof $Id$ */
diff --git a/byterun/instrtrace.h b/byterun/instrtrace.h
index 6b899766b0..9df4a62352 100644
--- a/byterun/instrtrace.h
+++ b/byterun/instrtrace.h
@@ -26,6 +26,6 @@ extern int caml_trace_flag;
 extern long caml_icount;
 void caml_stop_here (void);
 void caml_disasm_instr (code_t pc);
-
-
+void caml_trace_value_file (value v, code_t prog, int proglen, FILE * f);
+void caml_trace_accu_sp_file(value accu, value * sp, code_t prog, int proglen, FILE * f);
 #endif
diff --git a/byterun/instruct.h b/byterun/instruct.h
index c0cf5f2df7..a2eb5b7b5e 100644
--- a/byterun/instruct.h
+++ b/byterun/instruct.h
@@ -53,6 +53,7 @@ enum instructions {
   BEQ, BNEQ,  BLTINT, BLEINT, BGTINT, BGEINT,
   ULTINT, UGEINT,
   BULTINT, BUGEINT,
+  GETPUBMET, GETDYNMET,
   STOP,
   EVENT, BREAK
 };
diff --git a/byterun/intern.c b/byterun/intern.c
index 34b22340a0..00872d6d50 100644
--- a/byterun/intern.c
+++ b/byterun/intern.c
@@ -651,8 +651,8 @@ CAMLexport void caml_deserialize_block_1(void * data, long len)
 
 CAMLexport void caml_deserialize_block_2(void * data, long len)
 {
-  unsigned char * p, * q;
 #ifndef ARCH_BIG_ENDIAN
+  unsigned char * p, * q;
   for (p = intern_src, q = data; len > 0; len--, p += 2, q += 2)
     Reverse_16(q, p);
   intern_src = p;
@@ -664,8 +664,8 @@ CAMLexport void caml_deserialize_block_2(void * data, long len)
 
 CAMLexport void caml_deserialize_block_4(void * data, long len)
 {
-  unsigned char * p, * q;
 #ifndef ARCH_BIG_ENDIAN
+  unsigned char * p, * q;
   for (p = intern_src, q = data; len > 0; len--, p += 4, q += 4)
     Reverse_32(q, p);
   intern_src = p;
@@ -677,8 +677,8 @@ CAMLexport void caml_deserialize_block_4(void * data, long len)
 
 CAMLexport void caml_deserialize_block_8(void * data, long len)
 {
-  unsigned char * p, * q;
 #ifndef ARCH_BIG_ENDIAN
+  unsigned char * p, * q;
   for (p = intern_src, q = data; len > 0; len--, p += 8, q += 8)
     Reverse_64(q, p);
   intern_src = p;
diff --git a/byterun/interp.c b/byterun/interp.c
index 146baa7744..abf504131a 100644
--- a/byterun/interp.c
+++ b/byterun/interp.c
@@ -114,7 +114,7 @@ sp is a local copy of the global variable caml_extern_sp. */
    For GCC, I have hand-assigned hardware registers for several architectures.
 */
 
-#if defined(__GNUC__) && !defined(DEBUG)
+#if defined(__GNUC__) && !defined(__INTEL_COMPILER) && !defined(DEBUG)
 #ifdef __mips__
 #define PC_REG asm("$16")
 #define SP_REG asm("$17")
@@ -183,6 +183,11 @@ extern long caml_safe_div(long p, long q);
 extern long caml_safe_mod(long p, long q);
 #endif
 
+
+#ifdef DEBUG
+static long caml_bcodcount;
+#endif
+
 /* The interpreter itself */
 
 value caml_interprete(code_t prog, asize_t prog_size)
@@ -207,15 +212,15 @@ value caml_interprete(code_t prog, asize_t prog_size)
   long extra_args;
   struct longjmp_buffer * initial_external_raise;
   int initial_sp_offset;
-  /* volatile prevents collapsing initial_local_roots with another
-     local variable, like Digital Unix 4.0 C compiler does (wrongly) */
+  /* volatile ensures that initial_local_roots and saved_pc
+     will keep correct value across longjmp */
   struct caml__roots_block * volatile initial_local_roots;
+  volatile code_t saved_pc;
   struct longjmp_buffer raise_buf;
   value * modify_dest, modify_newval;
 #ifndef THREADED_CODE
   opcode_t curr_instr;
 #endif
-  code_t saved_pc;
 
 #ifdef THREADED_CODE
   static void * jumptable[] = {
@@ -266,8 +271,17 @@ value caml_interprete(code_t prog, asize_t prog_size)
 #else
   while(1) {
 #ifdef DEBUG
+    caml_bcodcount++;
     if (caml_icount-- == 0) caml_stop_here ();
+    if (caml_trace_flag>1) printf("\n##%ld\n", caml_bcodcount);
     if (caml_trace_flag) caml_disasm_instr(pc);
+    if (caml_trace_flag>1) {
+      printf("env=");
+      caml_trace_value_file(env,prog,prog_size,stdout);
+      putchar('\n');
+      caml_trace_accu_sp_file(accu,sp,prog,prog_size,stdout);
+      fflush(stdout);
+    };
     Assert(sp >= caml_stack_low);
     Assert(sp <= caml_stack_high);
 #endif
@@ -1012,14 +1026,73 @@ value caml_interprete(code_t prog, asize_t prog_size)
     
 /* Object-oriented operations */
 
-#define Lookup(obj, lab) \
-  Field (Field (Field (obj, 0), ((lab) >> 16) / sizeof (value)), \
-         ((lab) / sizeof (value)) & 0xFF)
+#define Lookup(obj, lab) Field (Field (obj, 0), Int_val(lab))
+
+      /* please don't forget to keep below code in sync with the
+	 functions caml_cache_public_method and
+	 caml_cache_public_method2 in obj.c */
 
     Instruct(GETMETHOD):
       accu = Lookup(sp[0], accu);
       Next;
 
+#define CAML_METHOD_CACHE
+#ifdef CAML_METHOD_CACHE
+    Instruct(GETPUBMET): {
+      /* accu == object, pc[0] == tag, pc[1] == cache */
+      value meths = Field (accu, 0);
+      value ofs;
+#ifdef CAML_TEST_CACHE
+      static int calls = 0, hits = 0;
+      if (calls >= 10000000) {
+        fprintf(stderr, "cache hit = %d%%\n", hits / 100000);
+        calls = 0; hits = 0;
+      }
+      calls++;
+#endif
+      *--sp = accu;
+      accu = Val_int(*pc++);
+      ofs = *pc & Field(meths,1);
+      if (*(value*)(((char*)&Field(meths,3)) + ofs) == accu) {
+#ifdef CAML_TEST_CACHE
+        hits++;
+#endif
+        accu = *(value*)(((char*)&Field(meths,2)) + ofs);
+      }
+      else
+      {
+        int li = 3, hi = Field(meths,0), mi;
+        while (li < hi) {
+          mi = ((li+hi) >> 1) | 1;
+          if (accu < Field(meths,mi)) hi = mi-2;
+          else li = mi;
+        }
+        *pc = (li-3)*sizeof(value);
+        accu = Field (meths, li-1);
+      }
+      pc++;
+      Next;
+    }
+#else
+    Instruct(GETPUBMET):
+      *--sp = accu;
+      accu = Val_int(*pc);
+      pc += 2;
+      /* Fallthrough */
+#endif
+    Instruct(GETDYNMET): {
+      /* accu == tag, sp[0] == object, *pc == cache */
+      value meths = Field (sp[0], 0);
+      int li = 3, hi = Field(meths,0), mi;
+      while (li < hi) {
+        mi = ((li+hi) >> 1) | 1;
+        if (accu < Field(meths,mi)) hi = mi-2;
+        else li = mi;
+      }
+      accu = Field (meths, li-1);
+      Next;
+    }
+
 /* Debugging and machine control */
 
     Instruct(STOP):
@@ -1054,3 +1127,22 @@ value caml_interprete(code_t prog, asize_t prog_size)
   }
 #endif
 }
+
+void caml_prepare_bytecode(code_t prog, asize_t prog_size) {
+  /* other implementations of the interpreter (such as an hypothetical
+     JIT translator) might want to do something with a bytecode before
+     running it */
+  Assert(prog);
+  Assert(prog_size>0);
+  /* actually, the threading of the bytecode might be done here */
+} 
+
+void caml_release_bytecode(code_t prog, asize_t prog_size) {
+  /* other implementations of the interpreter (such as an hypothetical
+     JIT translator) might want to know when a bytecode is removed */
+  /* check that we have a program */
+  Assert(prog);
+  Assert(prog_size>0);
+}
+
+/* eof $Id$ */
diff --git a/byterun/interp.h b/byterun/interp.h
index 075f0ff818..9eb7339405 100644
--- a/byterun/interp.h
+++ b/byterun/interp.h
@@ -18,11 +18,16 @@
 #ifndef CAML_INTERP_H
 #define CAML_INTERP_H
 
-
 #include "misc.h"
 #include "mlvalues.h"
 
+/* interpret a bytecode */
 value caml_interprete (code_t prog, asize_t prog_size);
 
+/* tell the runtime that a bytecode program might be needed */
+void caml_prepare_bytecode(code_t prog, asize_t prog_size);
+
+/* tell the runtime that a bytecode program is no more needed */
+void caml_release_bytecode(code_t prog, asize_t prog_size);
 
 #endif /* CAML_INTERP_H */
diff --git a/byterun/major_gc.c b/byterun/major_gc.c
index d39cd2f203..06183d5196 100644
--- a/byterun/major_gc.c
+++ b/byterun/major_gc.c
@@ -42,7 +42,8 @@ static asize_t gray_vals_size;
 static int heap_is_pure;   /* The heap is pure if the only gray objects
                               below [markhp] are also in [gray_vals]. */
 unsigned long caml_allocated_words;
-double caml_extra_heap_memory;
+unsigned long caml_dependent_size, caml_dependent_allocated;
+double caml_extra_heap_resources;
 unsigned long caml_fl_size_at_phase_change = 0;
 
 extern char *caml_fl_merge;  /* Defined in freelist.c. */
@@ -294,7 +295,7 @@ static void sweep_slice (long work)
  */
 long caml_major_collection_slice (long howmuch)
 {
-  double p;
+  double p, dp;
   long computed_work;
   /*
      Free memory at the start of the GC cycle (garbage + free list) (assumed):
@@ -304,15 +305,15 @@ long caml_major_collection_slice (long howmuch)
      Assuming steady state and enforcing a constant allocation rate, then
      FM is divided in 2/3 for garbage and 1/3 for free list.
                  G = 2 * FM / 3
-     G is also the amount of memory that will be used during this slice
+     G is also the amount of memory that will be used during this cycle
      (still assuming steady state).
 
      Proportion of G consumed since the previous slice:
                  PH = caml_allocated_words / G
                     = caml_allocated_words * 3 * (100 + caml_percent_free)
                       / (2 * caml_stat_heap_size * caml_percent_free)
-     Proportion of extra-heap memory consumed since the previous slice:
-                 PE = caml_extra_heap_memory
+     Proportion of extra-heap resources consumed since the previous slice:
+                 PE = caml_extra_heap_resources
      Proportion of total work to do in this slice:
                  P  = max (PH, PE)
      Amount of marking work for the GC cycle:
@@ -332,11 +333,18 @@ long caml_major_collection_slice (long howmuch)
 
   p = (double) caml_allocated_words * 3.0 * (100 + caml_percent_free)
       / Wsize_bsize (caml_stat_heap_size) / caml_percent_free / 2.0;
-  if (p < caml_extra_heap_memory) p = caml_extra_heap_memory;
+  if (caml_dependent_size > 0){
+    dp = (double) caml_dependent_allocated * (100 + caml_percent_free)
+         / caml_dependent_size / caml_percent_free;
+  }else{
+    dp = 0.0;
+  }
+  if (p < dp) p = dp;
+  if (p < caml_extra_heap_resources) p = caml_extra_heap_resources;
 
   caml_gc_message (0x40, "allocated_words = %lu\n", caml_allocated_words);
-  caml_gc_message (0x40, "extra_heap_memory = %luu\n",
-                   (unsigned long) (caml_extra_heap_memory * 1000000));
+  caml_gc_message (0x40, "extra_heap_resources = %luu\n",
+                   (unsigned long) (caml_extra_heap_resources * 1000000));
   caml_gc_message (0x40, "amount of work to do = %luu\n",
                    (unsigned long) (p * 1000000));
 
@@ -362,7 +370,8 @@ long caml_major_collection_slice (long howmuch)
 
   caml_stat_major_words += caml_allocated_words;
   caml_allocated_words = 0;
-  caml_extra_heap_memory = 0.0;
+  caml_dependent_allocated = 0;
+  caml_extra_heap_resources = 0.0;
   return computed_work;
 }
 
@@ -417,7 +426,6 @@ asize_t caml_round_heap_chunk_size (asize_t request)
 void caml_init_major_heap (asize_t heap_size)
 {
   asize_t i;
-  void *block;
   asize_t page_table_size;
   page_table_entry *page_table_block;
 
@@ -459,5 +467,5 @@ void caml_init_major_heap (asize_t heap_size)
   gray_vals_end = gray_vals + gray_vals_size;
   heap_is_pure = 1;
   caml_allocated_words = 0;
-  caml_extra_heap_memory = 0.0;
+  caml_extra_heap_resources = 0.0;
 }
diff --git a/byterun/major_gc.h b/byterun/major_gc.h
index 0c3eb14ec0..3a53d04ac2 100644
--- a/byterun/major_gc.h
+++ b/byterun/major_gc.h
@@ -34,7 +34,8 @@ typedef struct {
 
 extern int caml_gc_phase;
 extern unsigned long caml_allocated_words;
-extern double caml_extra_heap_memory;
+extern double caml_extra_heap_resources;
+extern unsigned long caml_dependent_size, caml_dependent_allocated;
 extern unsigned long caml_fl_size_at_phase_change;
 
 #define Phase_mark 0
diff --git a/byterun/memory.c b/byterun/memory.c
index 824a01d44c..a4780c6ea2 100644
--- a/byterun/memory.c
+++ b/byterun/memory.c
@@ -21,6 +21,7 @@
 #include "gc_ctrl.h"
 #include "major_gc.h"
 #include "memory.h"
+#include "major_gc.h"
 #include "minor_gc.h"
 #include "misc.h"
 #include "mlvalues.h"
@@ -297,26 +298,49 @@ CAMLexport value caml_alloc_shr (mlsize_t wosize, tag_t tag)
   return Val_hp (hp);
 }
 
+/* Dependent memory is all memory blocks allocated out of the heap
+   that depend on the GC (and finalizers) for deallocation.
+   For the GC to take dependent memory in its automatic speed setting,
+   you must call [caml_alloc_dependent_memory] when you alloate some
+   dependent memory, and [caml_free_dependent_memory] when you
+   free it.  In both cases, you pass as argument the size of the
+   block being allocated or freed.
+*/
+CAMLexport void caml_alloc_dependent_memory (mlsize_t nbytes)
+{
+  caml_dependent_size += nbytes / sizeof (value);
+  caml_dependent_allocated += nbytes / sizeof (value);
+}
+
+CAMLexport void caml_free_dependent_memory (mlsize_t nbytes)
+{
+  if (caml_dependent_size < nbytes / sizeof (value)){
+    caml_dependent_size = 0;
+  }else{
+    caml_dependent_size -= nbytes / sizeof (value);
+  }
+}
+
 /* Use this function to tell the major GC to speed up when you use
-   finalized blocks to automatically deallocate extra-heap stuff.
-   The GC will do at least one cycle every [max] allocated words;
-   [mem] is the number of words allocated this time.
-   Note that only [mem/max] is relevant.  You can use numbers of bytes
-   (or kilobytes, ...) instead of words.  You can change units between
-   calls to [caml_adjust_gc_speed].
+   finalized blocks to automatically deallocate resources (other
+   than memory). The GC will do at least one cycle every [max]
+   allocated resources; [res] is the number of resources allocated
+   this time.
+   Note that only [res/max] is relevant.  The units (and kind of
+   resource) can change between calls to [caml_adjust_gc_speed].
 */
-CAMLexport void caml_adjust_gc_speed (mlsize_t mem, mlsize_t max)
+CAMLexport void caml_adjust_gc_speed (mlsize_t res, mlsize_t max)
 {
   if (max == 0) max = 1;
-  if (mem > max) mem = max;
-  caml_extra_heap_memory += (double) mem / (double) max;
-  if (caml_extra_heap_memory > 1.0){
-    caml_extra_heap_memory = 1.0;
+  if (res > max) res = max;
+  caml_extra_heap_resources += (double) res / (double) max;
+  if (caml_extra_heap_resources > 1.0){
+    caml_extra_heap_resources = 1.0;
     caml_urge_major_slice ();
   }
-  if (caml_extra_heap_memory > (double) Wsize_bsize (caml_minor_heap_size)
-                               / 2.0
-                               / (double) Wsize_bsize (caml_stat_heap_size)) {
+  if (caml_extra_heap_resources
+           > (double) Wsize_bsize (caml_minor_heap_size) / 2.0
+             / (double) Wsize_bsize (caml_stat_heap_size)) {
     caml_urge_major_slice ();
   }
 }
diff --git a/byterun/memory.h b/byterun/memory.h
index 4be908b8c5..f986793c9a 100644
--- a/byterun/memory.h
+++ b/byterun/memory.h
@@ -32,6 +32,8 @@
 
 CAMLextern value caml_alloc_shr (mlsize_t, tag_t);
 CAMLextern void caml_adjust_gc_speed (mlsize_t, mlsize_t);
+CAMLextern void caml_alloc_dependent_memory (mlsize_t);
+CAMLextern void caml_free_dependent_memory (mlsize_t);
 CAMLextern void caml_modify (value *, value);
 CAMLextern void caml_initialize (value *, value);
 CAMLextern value caml_check_urgent_gc (value);
@@ -168,9 +170,15 @@ CAMLextern struct caml__roots_block *caml_local_roots;  /* defined in roots.c */
   CAMLxparamN (x, (size))
 
 
+#if defined (__GNUC__)
+  #define CAMLunused __attribute__ ((unused))
+#else
+  #define CAMLunused
+#endif
+
 #define CAMLxparam1(x) \
   struct caml__roots_block caml__roots_##x; \
-  int caml__dummy_##x = ( \
+  CAMLunused int caml__dummy_##x = ( \
     (caml__roots_##x.next = caml_local_roots), \
     (caml_local_roots = &caml__roots_##x), \
     (caml__roots_##x.nitems = 1), \
@@ -180,7 +188,7 @@ CAMLextern struct caml__roots_block *caml_local_roots;  /* defined in roots.c */
 
 #define CAMLxparam2(x, y) \
   struct caml__roots_block caml__roots_##x; \
-  int caml__dummy_##x = ( \
+  CAMLunused int caml__dummy_##x = ( \
     (caml__roots_##x.next = caml_local_roots), \
     (caml_local_roots = &caml__roots_##x), \
     (caml__roots_##x.nitems = 1), \
@@ -191,7 +199,7 @@ CAMLextern struct caml__roots_block *caml_local_roots;  /* defined in roots.c */
 
 #define CAMLxparam3(x, y, z) \
   struct caml__roots_block caml__roots_##x; \
-  int caml__dummy_##x = ( \
+  CAMLunused int caml__dummy_##x = ( \
     (caml__roots_##x.next = caml_local_roots), \
     (caml_local_roots = &caml__roots_##x), \
     (caml__roots_##x.nitems = 1), \
@@ -203,7 +211,7 @@ CAMLextern struct caml__roots_block *caml_local_roots;  /* defined in roots.c */
 
 #define CAMLxparam4(x, y, z, t) \
   struct caml__roots_block caml__roots_##x; \
-  int caml__dummy_##x = ( \
+  CAMLunused int caml__dummy_##x = ( \
     (caml__roots_##x.next = caml_local_roots), \
     (caml_local_roots = &caml__roots_##x), \
     (caml__roots_##x.nitems = 1), \
@@ -216,7 +224,7 @@ CAMLextern struct caml__roots_block *caml_local_roots;  /* defined in roots.c */
 
 #define CAMLxparam5(x, y, z, t, u) \
   struct caml__roots_block caml__roots_##x; \
-  int caml__dummy_##x = ( \
+  CAMLunused int caml__dummy_##x = ( \
     (caml__roots_##x.next = caml_local_roots), \
     (caml_local_roots = &caml__roots_##x), \
     (caml__roots_##x.nitems = 1), \
@@ -230,7 +238,7 @@ CAMLextern struct caml__roots_block *caml_local_roots;  /* defined in roots.c */
 
 #define CAMLxparamN(x, size) \
   struct caml__roots_block caml__roots_##x; \
-  int caml__dummy_##x = ( \
+  CAMLunused int caml__dummy_##x = ( \
     (caml__roots_##x.next = caml_local_roots), \
     (caml_local_roots = &caml__roots_##x), \
     (caml__roots_##x.nitems = (size)), \
@@ -273,6 +281,9 @@ CAMLextern struct caml__roots_block *caml_local_roots;  /* defined in roots.c */
   return (result); \
 }while(0)
 
+#define CAMLnoreturn ((void) caml__frame)
+
+
 /* convenience macro */
 #define Store_field(block, offset, val) do{ \
   mlsize_t caml__temp_offset = (offset); \
diff --git a/byterun/meta.c b/byterun/meta.c
index 021e4680cb..ac86ee8e17 100644
--- a/byterun/meta.c
+++ b/byterun/meta.c
@@ -55,6 +55,7 @@ CAMLprim value caml_reify_bytecode(value prog, value len)
 #ifdef THREADED_CODE
   caml_thread_code((code_t) prog, (asize_t) Long_val(len));
 #endif
+  caml_prepare_bytecode((code_t) prog, (asize_t) Long_val(len));
   clos = caml_alloc_small (1, Closure_tag);
   Code_val(clos) = (code_t) prog;
   return clos;
diff --git a/byterun/misc.c b/byterun/misc.c
index 618729e4af..8791eca42a 100644
--- a/byterun/misc.c
+++ b/byterun/misc.c
@@ -41,19 +41,20 @@ void caml_gc_message (int level, char *msg, unsigned long arg)
   }
 }
 
-void caml_fatal_error (char *msg)
+CAMLexport void caml_fatal_error (char *msg)
 {
   fprintf (stderr, "%s", msg);
   exit(2);
 }
 
-void caml_fatal_error_arg (char *fmt, char *arg)
+CAMLexport void caml_fatal_error_arg (char *fmt, char *arg)
 {
   fprintf (stderr, fmt, arg);
   exit(2);
 }
 
-void caml_fatal_error_arg2 (char *fmt1, char *arg1, char *fmt2, char *arg2)
+CAMLexport void caml_fatal_error_arg2 (char *fmt1, char *arg1,
+				       char *fmt2, char *arg2)
 {
   fprintf (stderr, fmt1, arg1);
   fprintf (stderr, fmt2, arg2);
diff --git a/byterun/misc.h b/byterun/misc.h
index 298e7c6693..bda864fc49 100644
--- a/byterun/misc.h
+++ b/byterun/misc.h
@@ -41,10 +41,10 @@ typedef char * addr;
 /* </private> */
 
 #ifdef __GNUC__
-/* Works only in GCC 2.5 and later */
-#define Noreturn __attribute ((noreturn))
+  /* Works only in GCC 2.5 and later */
+  #define Noreturn __attribute__ ((noreturn))
 #else
-#define Noreturn
+  #define Noreturn
 #endif
 
 /* Export control (to mark primitives and to handle Windows DLL) */
@@ -69,15 +69,15 @@ typedef char * addr;
 
 #ifdef DEBUG
 #define CAMLassert(x) ((x) ? 0 : caml_failed_assert ( #x , __FILE__, __LINE__))
-int caml_failed_assert (char *, char *, int);
+CAMLextern int caml_failed_assert (char *, char *, int);
 #else
-#define CAMLassert(x) 0
+#define CAMLassert(x) ((void) 0)
 #endif
 
-void caml_fatal_error (char *msg) Noreturn;
-void caml_fatal_error_arg (char *fmt, char *arg) Noreturn;
-void caml_fatal_error_arg2 (char *fmt1, char *arg1, 
-                            char *fmt2, char *arg2) Noreturn;
+CAMLextern void caml_fatal_error (char *msg) Noreturn;
+CAMLextern void caml_fatal_error_arg (char *fmt, char *arg) Noreturn;
+CAMLextern void caml_fatal_error_arg2 (char *fmt1, char *arg1, 
+				       char *fmt2, char *arg2) Noreturn;
 
 /* Data structures */
 
diff --git a/byterun/obj.c b/byterun/obj.c
index 277c24180a..809aeab6d0 100644
--- a/byterun/obj.c
+++ b/byterun/obj.c
@@ -19,6 +19,7 @@
 #include "alloc.h"
 #include "fail.h"
 #include "gc.h"
+#include "interp.h"
 #include "major_gc.h"
 #include "memory.h"
 #include "minor_gc.h"
@@ -37,6 +38,21 @@ CAMLprim value caml_static_free(value blk)
   return Val_unit;
 }
 
+/* signal to the interpreter machinery that a bytecode is no more
+   needed (before freeing it) - this might be useful for a JIT
+   implementation */
+
+CAMLprim value caml_static_release_bytecode(value blk, value size)
+{
+#ifndef NATIVE_CODE
+  caml_release_bytecode((code_t) blk, (asize_t) Long_val(size));
+#else
+  caml_failwith("Meta.static_release_bytecode impossible with native code");
+#endif
+  return Val_unit;
+}
+
+
 CAMLprim value caml_static_resize(value blk, value new_size)
 {
   return (value) caml_stat_resize((char *) blk, (asize_t) Long_val(new_size));
@@ -181,3 +197,59 @@ CAMLprim value caml_lazy_make_forward (value v)
   Modify (&Field (res, 0), v);
   CAMLreturn (res);
 }
+
+/* For camlinternalOO.ml
+   See also GETPUBMET in interp.c
+ */
+
+CAMLprim value caml_get_public_method (value obj, value tag)
+{
+  value meths = Field (obj, 0);
+  int li = 3, hi = Field(meths,0), mi;
+  while (li < hi) {
+    mi = ((li+hi) >> 1) | 1;
+    if (tag < Field(meths,mi)) hi = mi-2;
+    else li = mi;
+  }
+  return Field (meths, li-1);
+}
+
+/* these two functions might be useful to an hypothetical JIT */
+
+#ifdef CAML_JIT
+#ifdef NATIVE_CODE
+#define MARK 1
+#else
+#define MARK 0
+#endif
+value caml_cache_public_method (value meths, value tag, value *cache)
+{
+  int li = 3, hi = Field(meths,0), mi;
+  while (li < hi) {
+    mi = ((li+hi) >> 1) | 1;
+    if (tag < Field(meths,mi)) hi = mi-2;
+    else li = mi;
+  }
+  *cache = (li-3)*sizeof(value) + MARK;
+  return Field (meths, li-1);
+}
+
+value caml_cache_public_method2 (value *meths, value tag, value *cache)
+{
+  value ofs = *cache & meths[1];
+  if (*(value*)(((char*)(meths+3)) + ofs - MARK) == tag)
+    return *(value*)(((char*)(meths+2)) + ofs - MARK);
+  {
+    int li = 3, hi = meths[0], mi;
+    while (li < hi) {
+      mi = ((li+hi) >> 1) | 1;
+      if (tag < meths[mi]) hi = mi-2;
+      else li = mi;
+    }
+    *cache = (li-3)*sizeof(value) + MARK;
+    return meths[li-1];
+  }
+}
+#endif /*CAML_JIT*/
+
+/* eof $Id$ */
diff --git a/byterun/parsing.c b/byterun/parsing.c
index 68e687ffdb..2d90fa5524 100644
--- a/byterun/parsing.c
+++ b/byterun/parsing.c
@@ -115,7 +115,6 @@ static char * token_name(char * names, int number)
 
 static void print_token(struct parser_tables *tables, int state, value tok)
 {
-  mlsize_t i;
   value v;
 
   if (Is_long(tok)) {
diff --git a/byterun/startup.c b/byterun/startup.c
index 7918f0eea3..57f8c970a5 100644
--- a/byterun/startup.c
+++ b/byterun/startup.c
@@ -236,7 +236,7 @@ static int parse_command_line(char **argv)
     switch(argv[i][1]) {
 #ifdef DEBUG
     case 't':
-      caml_trace_flag = 1;
+      caml_trace_flag++;
       break;
 #endif
     case 'v':
diff --git a/byterun/str.c b/byterun/str.c
index 08bbf839e7..8151fa37c1 100644
--- a/byterun/str.c
+++ b/byterun/str.c
@@ -83,7 +83,7 @@ CAMLprim value caml_string_notequal(value s1, value s2)
 
 CAMLprim value caml_string_compare(value s1, value s2)
 {
-  mlsize_t len1, len2, len;
+  mlsize_t len1, len2;
   int res;
 
   len1 = caml_string_length(s1);
diff --git a/byterun/sys.c b/byterun/sys.c
index 96d0c7bb2a..c5f5c60e14 100644
--- a/byterun/sys.c
+++ b/byterun/sys.c
@@ -51,32 +51,11 @@
 extern int errno;
 #endif
 
-#ifdef HAS_STRERROR
-
-#ifndef _WIN32
-extern char * strerror(int);
-#endif
-
 static char * error_message(void)
 {
   return strerror(errno);
 }
 
-#else
-
-extern int sys_nerr;
-extern char * sys_errlist [];
-
-static char * error_message(void)
-{
-  if (errno < 0 || errno >= sys_nerr)
-    return "unknown error";
-  else
-    return sys_errlist[errno];
-}
-
-#endif /* HAS_STRERROR */
-
 #ifndef EAGAIN
 #define EAGAIN (-1)
 #endif
@@ -106,6 +85,7 @@ CAMLexport void caml_sys_error(value arg)
     }
     caml_raise_sys_error(str);
   }
+  CAMLnoreturn;
 }
 
 CAMLprim value caml_sys_exit(value retcode)
@@ -179,7 +159,7 @@ CAMLprim value caml_sys_remove(value name)
 CAMLprim value caml_sys_rename(value oldname, value newname)
 {
   if (rename(String_val(oldname), String_val(newname)) != 0)
-    caml_sys_error(oldname);
+    caml_sys_error(NO_ARG);
   return Val_unit;
 }
 
diff --git a/camlp4/CHANGES b/camlp4/CHANGES
index 0cba993c44..2ad2822777 100644
--- a/camlp4/CHANGES
+++ b/camlp4/CHANGES
@@ -1,3 +1,10 @@
+- [12 may 2004] Added to the camlp4 tools the -version option that prints
+  the version number, in the same way as the other ocaml tools.
+- [12 may 04] Locations are now handled as in OCaml. The main benefit
+  is that line numbers are now correct in error messages. However, this
+  slightly changes the interface of a few Camlp4 modules (see ICHANGES).
+  ** Warning: Some contribs of the camlp4 distribution are broken because
+  of this change. In particular the scheme/lisp syntaxes.
 - [20 nov 03] Illegal escape sequences in strings now issue a warning.
 
 Camlp4 Version 3.07
diff --git a/camlp4/ICHANGES b/camlp4/ICHANGES
index 5b17aaf71d..809a65a669 100644
--- a/camlp4/ICHANGES
+++ b/camlp4/ICHANGES
@@ -1,6 +1,13 @@
 Internal, very small, undocumented, or invisible changes
 ********************************************************
 
+- [april-may 04] the following interface files changed in order to
+  implement OCaml style locations:
+        camlp4/camlp4/{ast2pt.mli,pcaml.mli,reloc.mli,grammar.mli}
+        camlp4/lib/{stdpp.mli,token.mli}
+  The main changes are occurrences of "int" changed into
+  "Lexing.position" and "int * int" changed into
+  "Lexing.position * Lexing.position" (or an equivalent type).
 - [20 nov 03], token.mli: eval_string takes a location as a extra
   argument (needed to issue a warning).
 
diff --git a/camlp4/Makefile b/camlp4/Makefile
index f80090a0b4..4e1e888c9b 100644
--- a/camlp4/Makefile
+++ b/camlp4/Makefile
@@ -2,9 +2,9 @@
 
 include config/Makefile
 
-DIRS=odyl camlp4 meta etc top ocpp lib man
+DIRS=odyl camlp4 meta lib etc top ocpp man
 FDIRS=odyl camlp4 meta lib
-OPTDIRS= lib odyl camlp4 meta etc compile
+OPTDIRS=lib odyl camlp4 meta etc compile
 SHELL=/bin/sh
 COLD_FILES=ocaml_src/camlp4/argl.ml ocaml_src/camlp4/ast2pt.ml ocaml_src/camlp4/ast2pt.mli ocaml_src/camlp4/mLast.mli ocaml_src/camlp4/pcaml.ml ocaml_src/camlp4/pcaml.mli ocaml_src/camlp4/quotation.ml ocaml_src/camlp4/quotation.mli ocaml_src/camlp4/reloc.ml ocaml_src/camlp4/reloc.mli ocaml_src/camlp4/spretty.ml ocaml_src/camlp4/spretty.mli ocaml_src/lib/extfun.ml ocaml_src/lib/extfun.mli ocaml_src/lib/fstream.ml ocaml_src/lib/fstream.mli ocaml_src/lib/gramext.ml ocaml_src/lib/gramext.mli ocaml_src/lib/grammar.ml ocaml_src/lib/grammar.mli ocaml_src/lib/plexer.ml ocaml_src/lib/plexer.mli ocaml_src/lib/stdpp.ml ocaml_src/lib/stdpp.mli ocaml_src/lib/token.ml ocaml_src/lib/token.mli ocaml_src/meta/pa_extend.ml ocaml_src/meta/pa_extend_m.ml ocaml_src/meta/pa_macro.ml ocaml_src/meta/pa_r.ml ocaml_src/meta/pa_rp.ml ocaml_src/meta/pr_dump.ml ocaml_src/meta/q_MLast.ml ocaml_src/odyl/odyl_main.ml ocaml_src/odyl/odyl_main.mli ocaml_src/odyl/odyl.ml
 
@@ -152,6 +152,29 @@ bootstrap_sources:
 		 done); \
 	done
 
+my_bootstrap_sources:
+	mkdir ocaml_src.new
+	@-for i in $(FDIRS); do \
+		(mkdir ocaml_src.new/$$i; cd ocaml_src.new/$$i; \
+		 sed 's/# $$Id.*\$$/# $(TXTGEN)/' ../../$$i/Makefile | \
+		 sed 's-include ../config-include ../../config-g' | \
+		 sed 's-../boot-../../boot-g' > Makefile; \
+		 sed 's/# $$Id.*\$$/# $(TXTGEN)/' ../../$$i/Makefile.Mac | \
+		 sed 's-:boot-::boot-g' > Makefile.Mac; \
+		 cp ../../$$i/.depend . ; \
+		 cp ../../$$i/Makefile.Mac.depend .); \
+	 done
+	@-for i in $(FDIRS); do \
+		(cd $$i; \
+		 for j in *.ml*; do \
+			echo ============================================; \
+			echo ocaml_src.new/$$i/$$j; \
+			$$HOME/bin/conv.sh $$j | \
+			sed 's/$$Id.*\$$/$(TXTGEN)/' > \
+			../ocaml_src.new/$$i/$$j; \
+		 done); \
+	done
+
 untouch_sources:
 	@-cd ocaml_src; \
 	for i in $(FDIRS); do \
diff --git a/camlp4/camlp4/.depend b/camlp4/camlp4/.depend
index 00ddb5ad46..63efcf4310 100644
--- a/camlp4/camlp4/.depend
+++ b/camlp4/camlp4/.depend
@@ -7,10 +7,12 @@ argl.cmo: ast2pt.cmi mLast.cmi ../odyl/odyl_main.cmi pcaml.cmi
 argl.cmx: ast2pt.cmx mLast.cmi ../odyl/odyl_main.cmx pcaml.cmx 
 ast2pt.cmo: $(OTOP)/parsing/asttypes.cmi $(OTOP)/parsing/location.cmi \
     $(OTOP)/parsing/longident.cmi mLast.cmi $(OTOP)/parsing/parsetree.cmi \
-    ast2pt.cmi 
+    pcaml.cmi ast2pt.cmi 
 ast2pt.cmx: $(OTOP)/parsing/asttypes.cmi $(OTOP)/parsing/location.cmx \
     $(OTOP)/parsing/longident.cmx mLast.cmi $(OTOP)/parsing/parsetree.cmi \
-    ast2pt.cmi 
+    pcaml.cmx ast2pt.cmi 
+pcaml.cmo: mLast.cmi quotation.cmi reloc.cmi spretty.cmi pcaml.cmi 
+pcaml.cmx: mLast.cmi quotation.cmx reloc.cmx spretty.cmx pcaml.cmi 
 crc.cmo: $(OTOP)/otherlibs/dynlink/dynlink.cmi 
 crc.cmx: $(OTOP)/otherlibs/dynlink/dynlink.cmx 
 pcaml.cmo: ast2pt.cmi mLast.cmi quotation.cmi reloc.cmi spretty.cmi pcaml.cmi 
diff --git a/camlp4/camlp4/Makefile b/camlp4/camlp4/Makefile
index 31ffc05057..088da74bbf 100644
--- a/camlp4/camlp4/Makefile
+++ b/camlp4/camlp4/Makefile
@@ -9,8 +9,8 @@ OCAMLCFLAGS= $(INCLUDES) -warn-error A $(INCLUDES)
 LINKFLAGS=$(INCLUDES)
 INTERFACES=-I $(OLIBDIR) Arg Array ArrayLabels Buffer Callback CamlinternalOO Char Complex Digest Filename Format Gc Genlex Hashtbl Int32 Int64 Lazy Lexing List ListLabels Map Marshal MoreLabels Nativeint Obj Oo Parsing Pervasives Printexc Printf Queue Random Scanf Set Sort Stack StdLabels Stream String StringLabels Sys Weak -I ../boot Extfold Extfun Fstream Gramext Grammar Plexer Stdpp Token -I $(OTOP)/utils Config Warnings -I $(OTOP)/parsing Asttypes Location Longident Parsetree -I . Ast2pt MLast Pcaml Quotation Spretty
 CAMLP4_INTF=$(OTOP)/utils/config.cmi $(OTOP)/utils/warnings.cmi $(OTOP)/parsing/asttypes.cmi $(OTOP)/parsing/location.cmi $(OTOP)/parsing/longident.cmi $(OTOP)/parsing/parsetree.cmi ast2pt.cmi mLast.cmi pcaml.cmi spretty.cmi quotation.cmi
-CAMLP4_OBJS=../boot/stdpp.cmo ../boot/token.cmo ../boot/plexer.cmo ../boot/gramext.cmo ../boot/grammar.cmo ../boot/extfold.cmo ../boot/extfun.cmo ../boot/fstream.cmo $(OTOP)/utils/config.cmo quotation.cmo ast2pt.cmo spretty.cmo reloc.cmo pcaml.cmo argl.cmo
-CAMLP4_XOBJS=../lib/stdpp.cmx ../lib/token.cmx ../lib/plexer.cmx ../lib/gramext.cmx ../lib/grammar.cmx ../lib/extfold.cmx ../lib/extfun.cmx ../lib/fstream.cmx $(OTOP)/utils/config.cmx quotation.cmx ast2pt.cmx spretty.cmx reloc.cmx pcaml.cmx argl.cmx
+CAMLP4_OBJS=../boot/stdpp.cmo ../boot/token.cmo ../boot/plexer.cmo ../boot/gramext.cmo ../boot/grammar.cmo ../boot/extfold.cmo ../boot/extfun.cmo ../boot/fstream.cmo $(OTOP)/utils/config.cmo quotation.cmo spretty.cmo reloc.cmo pcaml.cmo ast2pt.cmo argl.cmo
+CAMLP4_XOBJS=../lib/stdpp.cmx ../lib/token.cmx ../lib/plexer.cmx ../lib/gramext.cmx ../lib/grammar.cmx ../lib/extfold.cmx ../lib/extfun.cmx ../lib/fstream.cmx $(OTOP)/utils/config.cmx quotation.cmx spretty.cmx reloc.cmx pcaml.cmx ast2pt.cmx argl.cmx
 OBJS=../odyl/odyl.cma camlp4.cma
 CAMLP4M=
 
@@ -22,7 +22,7 @@ opt: $(OBJS:.cma=.cmxa)
 optp4: $(CAMLP4OPT)
 
 $(CAMLP4): $(OBJS) ../odyl/odyl.cmo
-	$(OCAMLC) $(OBJS) $(CAMLP4M) ../odyl/odyl.cmo -linkall -o $(CAMLP4)
+	$(OCAMLC) -g $(OBJS) $(CAMLP4M) ../odyl/odyl.cmo -linkall -o $(CAMLP4)
 
 $(CAMLP4OPT): $(OBJS:.cma=.cmxa) ../odyl/odyl.cmx
 	$(OCAMLOPT) $(OBJS:.cma=.cmxa) $(CAMLP4M) ../odyl/odyl.cmx -linkall -o $(CAMLP4OPT)
diff --git a/camlp4/camlp4/argl.ml b/camlp4/camlp4/argl.ml
index 8880f07fd1..b726316e9c 100644
--- a/camlp4/camlp4/argl.ml
+++ b/camlp4/camlp4/argl.ml
@@ -123,7 +123,7 @@ value print_location loc =
   if Pcaml.input_file.val <> "-" then
     let (fname, line, bp, ep) = Stdpp.line_of_loc Pcaml.input_file.val loc in
     eprintf loc_fmt Pcaml.input_file.val line bp ep
-  else eprintf "At location %d-%d\n" (fst loc) (snd loc)
+  else eprintf "At location %d-%d\n" (fst loc).Lexing.pos_cnum (snd loc).Lexing.pos_cnum
 ;
 
 value print_warning loc s =
@@ -216,6 +216,12 @@ value file_kind_of_name name =
   else raise (Arg.Bad ("don't know what to do with " ^ name))
 ;
 
+value print_version_string () =
+  do {
+    print_string Pcaml.version; print_newline(); exit 0
+  }
+;
+
 value print_version () =
   do {
     eprintf "Camlp4 version %s\n" Pcaml.version; flush stderr; exit 0
@@ -343,7 +349,10 @@ value initial_spec_list =
    ("-o", Arg.String (fun x -> Pcaml.output_file.val := Some x),
     "<file> Output on <file> instead of standard output.");
    ("-v", Arg.Unit print_version,
-    "Print Camlp4 version and exit.")]
+    "Print Camlp4 version and exit.");
+   ("-version", Arg.Unit print_version_string,
+    "Print Camlp4 version number and exit.")
+ ]
 ;
 
 value anon_fun x =
diff --git a/camlp4/camlp4/ast2pt.ml b/camlp4/camlp4/ast2pt.ml
index 09b2e037b3..44ad62f4c2 100644
--- a/camlp4/camlp4/ast2pt.ml
+++ b/camlp4/camlp4/ast2pt.ml
@@ -19,7 +19,7 @@ open Longident;
 open Asttypes;
 
 value fast = ref False;
-value no_constructors_arity = ref False;
+value no_constructors_arity = Pcaml.no_constructors_arity;
 
 value get_tag x =
   if Obj.is_block (Obj.repr x) then Obj.tag (Obj.repr x) else Obj.magic x
@@ -39,24 +39,35 @@ value string_of_string_token loc s =
 value glob_fname = ref "";
 
 value mkloc (bp, ep) =
-  let loc_at n = {
-        Lexing.pos_fname = glob_fname.val;
-        Lexing.pos_lnum = 1;  (* ddr met -1 ici ??? *)
-        Lexing.pos_bol = 0;
-        Lexing.pos_cnum = n
+  let loc_at n = 
+    { (n) with
+        Lexing.pos_fname = 
+          if n.Lexing.pos_fname = "" then
+            if glob_fname.val = "" then
+              Pcaml.input_file.val
+            else
+              glob_fname.val
+          else
+            n.Lexing.pos_fname
       }
   in
   {Location.loc_start = loc_at bp;
    Location.loc_end = loc_at ep;
-   Location.loc_ghost = False} (* ddr met: bp = 0 && ep = 0 *)
+   Location.loc_ghost =
+     bp.Lexing.pos_cnum = 0 && ep.Lexing.pos_cnum = 0}
 ;
 
 value mkghloc (bp, ep) =
-  let loc_at n = {
-        Lexing.pos_fname = "";
-        Lexing.pos_lnum = 1;
-        Lexing.pos_bol = 0;
-        Lexing.pos_cnum = n
+  let loc_at n = 
+    { (n) with
+        Lexing.pos_fname = 
+          if n.Lexing.pos_fname = "" then
+            if glob_fname.val = "" then
+              Pcaml.input_file.val
+            else
+              glob_fname.val
+          else
+            n.Lexing.pos_fname
       }
   in
   {Location.loc_start = loc_at bp;
@@ -131,22 +142,37 @@ value rec ctyp_fa al =
   | f -> (f, al) ]
 ;
 
-value rec ctyp_long_id =
-  fun
+value rec ctyp_long_id_prefix t =
+  match t with
   [ TyAcc _ m (TyLid _ s) ->
-      let (is_cls, li) = ctyp_long_id m in
-      (is_cls, ldot li s)
+      error (loc_of_ctyp t) "invalid module expression"
   | TyAcc _ m (TyUid _ s) ->
-      let (is_cls, li) = ctyp_long_id m in
+      let (is_cls, li) = ctyp_long_id_prefix m in
       (is_cls, ldot li s)
   | TyApp _ m1 m2 ->
-      let (is_cls, li1) = ctyp_long_id m1 in
-      let (_, li2) = ctyp_long_id m2 in
+      let (is_cls, li1) = ctyp_long_id_prefix m1 in
+      let (_, li2) = ctyp_long_id_prefix m2 in
       (is_cls, Lapply li1 li2)
   | TyUid _ s -> (False, lident s)
+  | TyLid _ s ->
+      error (loc_of_ctyp t) "invalid module expression"
+  | t -> error (loc_of_ctyp t) "invalid module expression" ]
+;
+
+value ctyp_long_id t =
+  match t with
+  [ TyAcc _ m (TyLid _ s) ->
+      let (is_cls, li) = ctyp_long_id_prefix m in
+      (is_cls, ldot li s)
+  | TyAcc _ m (TyUid _ s as t) ->
+      error (loc_of_ctyp t) "invalid type name"
+  | TyApp _ m1 m2 ->
+      error (loc_of_ctyp t) "invalid type name"
+  | TyUid _ s ->
+      error (loc_of_ctyp t) "invalid type name"
   | TyLid _ s -> (False, lident s)
   | TyCls loc sl -> (True, long_id_of_string_list loc sl)
-  | t -> error (loc_of_ctyp t) "incorrect type" ]
+  | t -> error (loc_of_ctyp t) "invalid type" ]
 ;
 
 value rec ctyp =
@@ -160,7 +186,7 @@ value rec ctyp =
         match (t1, t2) with
         [ (t, TyQuo _ s) -> (t, s)
         | (TyQuo _ s, t) -> (t, s)
-        | _ -> error loc "incorrect alias type" ]
+        | _ -> error loc "invalid alias type" ]
       in
       mktyp loc (Ptyp_alias (ctyp t) i)
   | TyAny loc -> mktyp loc Ptyp_any
@@ -187,7 +213,7 @@ value rec ctyp =
   | TyRec loc _ _ -> error loc "record type not allowed here"
   | TySum loc _ _ -> error loc "sum type not allowed here"
   | TyTup loc tl -> mktyp loc (Ptyp_tuple (List.map ctyp tl))
-  | TyUid loc s -> mktyp loc (Ptyp_constr (lident s) [])
+  | TyUid loc s as t -> error (loc_of_ctyp t) "invalid type"
   | TyVrn loc catl ool ->
       let catl =
         List.map
@@ -391,7 +417,7 @@ value rec patt =
         match (p1, p2) with
         [ (p, PaLid _ s) -> (p, s)
         | (PaLid _ s, p) -> (p, s)
-        | _ -> error loc "incorrect alias pattern" ]
+        | _ -> error loc "invalid alias pattern" ]
       in
       mkpat loc (Ppat_alias (patt p) i)
   | PaAnt _ p -> patt p
@@ -615,6 +641,14 @@ value rec expr =
   | ExLmd loc i me e -> mkexp loc (Pexp_letmodule i (module_expr me) (expr e))
   | ExMat loc e pel -> mkexp loc (Pexp_match (expr e) (List.map mkpwe pel))
   | ExNew loc id -> mkexp loc (Pexp_new (long_id_of_string_list loc id))
+  | ExObj loc po cfl -> 
+      let p =
+        match po with
+        [ Some p -> p
+        | None -> PaAny loc ]
+      in
+      let cil = List.fold_right class_str_item cfl [] in
+      mkexp loc (Pexp_object (patt p, cil))
   | ExOlb loc _ _ -> error loc "labeled expression not allowed here"
   | ExOvr loc iel -> mkexp loc (Pexp_override (List.map mkideexp iel))
   | ExRec loc lel eo ->
diff --git a/camlp4/camlp4/ast2pt.mli b/camlp4/camlp4/ast2pt.mli
index 3e7da854f6..cc5a225c08 100644
--- a/camlp4/camlp4/ast2pt.mli
+++ b/camlp4/camlp4/ast2pt.mli
@@ -14,8 +14,8 @@
 
 value fast : ref bool;
 value no_constructors_arity : ref bool;
-value mkloc : (int * int) -> Location.t;
-value long_id_of_string_list : (int * int) -> list string -> Longident.t;
+value mkloc : MLast.loc -> Location.t;
+value long_id_of_string_list : MLast.loc -> list string -> Longident.t;
 
 value str_item : MLast.str_item -> Parsetree.structure -> Parsetree.structure;
 value interf : list MLast.sig_item -> Parsetree.signature;
diff --git a/camlp4/camlp4/mLast.mli b/camlp4/camlp4/mLast.mli
index 2d77944318..a4925bcd2c 100644
--- a/camlp4/camlp4/mLast.mli
+++ b/camlp4/camlp4/mLast.mli
@@ -19,7 +19,7 @@
    these values in concrete syntax (see the Camlp4 documentation).
    See also the file q_MLast.ml in Camlp4 sources. *)
 
-type loc = (int * int);
+type loc = (Lexing.position * Lexing.position);
 
 type ctyp =
   [ TyAcc of loc and ctyp and ctyp
@@ -104,6 +104,7 @@ and expr =
   | ExLmd of loc and string and module_expr and expr
   | ExMat of loc and expr and list (patt * option expr * expr)
   | ExNew of loc and list string
+  | ExObj of loc and option patt and list class_str_item
   | ExOlb of loc and string and option expr
   | ExOvr of loc and list (string * expr)
   | ExRec of loc and list (patt * expr) and option expr
diff --git a/camlp4/camlp4/pcaml.ml b/camlp4/camlp4/pcaml.ml
index 63c083ceba..77f223ff46 100644
--- a/camlp4/camlp4/pcaml.ml
+++ b/camlp4/camlp4/pcaml.ml
@@ -58,7 +58,10 @@ value input_file = ref "";
 value output_file = ref None;
 
 value warning_default_function (bp, ep) txt =
-  do { Printf.eprintf "<W> loc %d %d: %s\n" bp ep txt; flush stderr }
+   let c1 = bp.Lexing.pos_cnum - bp.Lexing.pos_bol in
+   let c2 = ep.Lexing.pos_cnum - bp.Lexing.pos_bol in
+  do { Printf.eprintf "<W> File \"%s\", line %d, chars %d-%d: %s\n"
+         bp.Lexing.pos_fname bp.Lexing.pos_lnum c1 c2 txt; flush stderr }
 ;
 
 value warning = ref warning_default_function;
@@ -82,21 +85,21 @@ List.iter (fun (n, f) -> Quotation.add n f)
 value quotation_dump_file = ref (None : option string);
 
 type err_ctx =
-  [ Finding | Expanding | ParsingResult of (int * int) and string | Locating ]
+  [ Finding | Expanding | ParsingResult of MLast.loc and string | Locating ]
 ;
 exception Qerror of string and err_ctx and exn;
 
 value expand_quotation loc expander shift name str =
   let new_warning =
     let warn = warning.val in
-    fun (bp, ep) txt -> warn (shift + bp, shift + ep) txt
+    fun (bp, ep) txt -> warn (Reloc.adjust_loc shift (bp, ep)) txt
   in
   apply_with_var warning new_warning
     (fun () ->
        try expander str with
-       [ Stdpp.Exc_located (p1, p2) exc ->
+       [ Stdpp.Exc_located loc exc ->
            let exc1 = Qerror name Expanding exc in
-           raise (Stdpp.Exc_located (shift + p1, shift + p2) exc1)
+           raise (Stdpp.Exc_located (Reloc.adjust_loc shift (Reloc.linearize loc)) exc1)
        | exc ->
            let exc1 = Qerror name Expanding exc in
            raise (Stdpp.Exc_located loc exc1) ])
@@ -106,7 +109,7 @@ value parse_quotation_result entry loc shift name str =
   let cs = Stream.of_string str in
   try Grammar.Entry.parse entry cs with
   [ Stdpp.Exc_located iloc (Qerror _ Locating _ as exc) ->
-      raise (Stdpp.Exc_located (shift + fst iloc, shift + snd iloc) exc)
+      raise (Stdpp.Exc_located (Reloc.adjust_loc shift iloc) exc)
   | Stdpp.Exc_located iloc (Qerror _ Expanding exc) ->
       let ctx = ParsingResult iloc str in
       let exc1 = Qerror name ctx exc in
@@ -119,18 +122,22 @@ value parse_quotation_result entry loc shift name str =
       raise (Stdpp.Exc_located loc exc1) ]
 ;
 
+value ghostify (bp, ep) =
+    let ghost p = { (p) with Lexing.pos_cnum = 0 } in
+    (ghost bp, ghost ep)
+;
+
 value handle_quotation loc proj in_expr entry reloc (name, str) =
   let shift =
     match name with
     [ "" -> String.length "<<"
     | _ -> String.length "<:" + String.length name + String.length "<" ]
   in
-  let shift = fst loc + shift in
+  let shift = Reloc.shift_pos shift (fst loc) in
   let expander =
     try Quotation.find name with exc ->
       let exc1 = Qerror name Finding exc in
-      let loc = (fst loc, shift) in
-      raise (Stdpp.Exc_located loc exc1)
+      raise (Stdpp.Exc_located (fst loc, shift) exc1)
   in
   let ast =
     match expander with
@@ -140,7 +147,14 @@ value handle_quotation loc proj in_expr entry reloc (name, str) =
     | Quotation.ExAst fe_fp ->
         expand_quotation loc (proj fe_fp) shift name str ]
   in
-  reloc (fun _ -> loc) shift ast
+  (* Warning: below, we use a side-effecting function that produces a real location
+     on its first call, and ghost ones at subsequent calls. *)
+  reloc
+    (let zero = ref None in
+     fun _ -> match zero.val with [
+       None -> do { zero.val := Some (ghostify loc) ; loc }
+     | Some x -> x ])
+    shift ast
 ;
 
 value parse_locate entry shift str =
@@ -149,12 +163,12 @@ value parse_locate entry shift str =
   [ Stdpp.Exc_located (p1, p2) exc ->
       let ctx = Locating in
       let exc1 = Qerror (Grammar.Entry.name entry) ctx exc in
-      raise (Stdpp.Exc_located (shift + p1, shift + p2) exc1) ]
+      raise (Stdpp.Exc_located (Reloc.adjust_loc shift (p1, p2)) exc1) ]
 ;
 
 value handle_locate loc entry ast_f (pos, str) =
   let s = str in
-  let loc = (pos, pos + String.length s) in
+  let loc = (pos, Reloc.shift_pos (String.length s) pos) in
   let x = parse_locate entry (fst loc) s in
   ast_f loc x
 ;
@@ -190,11 +204,9 @@ value patt_reloc = Reloc.patt;
 value rename_id = ref (fun x -> x);
 
 value find_line (bp, ep) str =
-  find 0 1 0 where rec find i line col =
-    if i == String.length str then (line, 0, col)
-    else if i == bp then (line, col, col + ep - bp)
-    else if str.[i] == '\n' then find (succ i) (succ line) 0
-    else find (succ i) line (succ col)
+  (bp.Lexing.pos_lnum,
+   bp.Lexing.pos_cnum - bp.Lexing.pos_bol,
+   ep.Lexing.pos_cnum - bp.Lexing.pos_bol)
 ;
 
 value loc_fmt =
@@ -355,7 +367,7 @@ value report_error exn =
   | e -> print_exn exn ]
 ;
 
-value no_constructors_arity = Ast2pt.no_constructors_arity;
+value no_constructors_arity = ref False;
 (*value no_assert = ref False;*)
 
 value arg_spec_list_ref = ref [];
diff --git a/camlp4/camlp4/pcaml.mli b/camlp4/camlp4/pcaml.mli
index c87ebe39ae..5fddb6b577 100644
--- a/camlp4/camlp4/pcaml.mli
+++ b/camlp4/camlp4/pcaml.mli
@@ -83,15 +83,15 @@ value no_constructors_arity : ref bool;
 value sync : ref (Stream.t char -> unit);
 
 value handle_expr_quotation : MLast.loc -> (string * string) -> MLast.expr;
-value handle_expr_locate : MLast.loc -> (int * string) -> MLast.expr;
+value handle_expr_locate : MLast.loc -> (Lexing.position * string) -> MLast.expr;
 
 value handle_patt_quotation : MLast.loc -> (string * string) -> MLast.patt;
-value handle_patt_locate : MLast.loc -> (int * string) -> MLast.patt;
+value handle_patt_locate : MLast.loc -> (Lexing.position * string) -> MLast.patt;
 
 value expr_reloc :
-  (MLast.loc -> MLast.loc) -> int -> MLast.expr -> MLast.expr;
+  (MLast.loc -> MLast.loc) -> Lexing.position -> MLast.expr -> MLast.expr;
 value patt_reloc :
-  (MLast.loc -> MLast.loc) -> int -> MLast.patt -> MLast.patt;
+  (MLast.loc -> MLast.loc) -> Lexing.position -> MLast.patt -> MLast.patt;
 
 (** To possibly rename identifiers; parsers may call this function
     when generating their identifiers; default = identity *)
@@ -99,7 +99,7 @@ value rename_id : ref (string -> string);
 
 (** Allow user to catch exceptions in quotations *)
 type err_ctx =
-  [ Finding | Expanding | ParsingResult of (int * int) and string | Locating ]
+  [ Finding | Expanding | ParsingResult of MLast.loc and string | Locating ]
 ;
 exception Qerror of string and err_ctx and exn;
 
@@ -151,7 +151,8 @@ value inter_phrases : ref (option string);
 
 (* for system use *)
 
-value warning : ref ((int * int) -> string -> unit);
+value warning : ref (MLast.loc -> string -> unit);
 value expr_eoi : Grammar.Entry.e MLast.expr;
 value patt_eoi : Grammar.Entry.e MLast.patt;
 value arg_spec_list : unit -> list (string * Arg.spec * string);
+value no_constructors_arity : ref bool;
diff --git a/camlp4/camlp4/reloc.ml b/camlp4/camlp4/reloc.ml
index 73f81b9b7b..9d0fa7e379 100644
--- a/camlp4/camlp4/reloc.ml
+++ b/camlp4/camlp4/reloc.ml
@@ -61,136 +61,229 @@ value class_infos a floc sh x =
    ciNam = x.ciNam; ciExp = a floc sh x.ciExp}
 ;
 
+(* Debugging positions and locations *)
+value eprint_pos msg p =
+   Printf.eprintf "%s: fname=%s; lnum=%d; bol=%d; cnum=%d\n%!"
+     msg p.Lexing.pos_fname p.Lexing.pos_lnum p.Lexing.pos_bol p.Lexing.pos_cnum
+;
+
+value eprint_loc (bp, ep) =
+ do { eprint_pos "   P1" bp; eprint_pos "   P2" ep }
+;
+   
+value check_position msg p =
+   let ok =
+     if (p.Lexing.pos_lnum < 0 ||
+         p.Lexing.pos_bol < 0 ||
+         p.Lexing.pos_cnum < 0 ||
+         p.Lexing.pos_cnum < p.Lexing.pos_bol)
+     then
+       do {
+         Printf.eprintf "*** Warning: (%s) strange position ***\n" msg;
+         eprint_pos msg p;
+         False
+          }
+     else
+       True in
+   (ok, p)
+;
+
+value check_location msg ((bp, ep) as loc) =
+   let ok =
+     let (ok1,_) = check_position "  From: " bp in
+     let (ok2,_) = check_position "    To: " ep in
+     if ((not ok1) || (not ok2) || 
+         bp.Lexing.pos_lnum > ep.Lexing.pos_lnum ||
+         bp.Lexing.pos_bol > ep.Lexing.pos_bol ||
+         bp.Lexing.pos_cnum > ep.Lexing.pos_cnum)
+     then
+       do {
+         Printf.eprintf "*** Warning: (%s) strange location ***\n" msg;
+         eprint_loc loc;
+         False
+          }
+     else
+       True in
+   (ok, loc)
+;
+
+(* Change a location into linear positions *)
+value linearize (bp, ep) =
+      ( { (bp) with Lexing.pos_lnum = 1; Lexing.pos_bol = 0 },
+        { (ep) with Lexing.pos_lnum = 1; Lexing.pos_bol = 0 })
+;
+
+value shift_pos n p =
+   { (p) with Lexing.pos_cnum = p.Lexing.pos_cnum + n }
+;
+
+value zero_loc =
+   { (Lexing.dummy_pos) with Lexing.pos_cnum = 0; Lexing.pos_lnum = 0 };
+
+
+value adjust_pos globpos local_pos =
+{
+  Lexing.pos_fname = globpos.Lexing.pos_fname;
+  Lexing.pos_lnum = globpos.Lexing.pos_lnum + local_pos.Lexing.pos_lnum - 1;
+  Lexing.pos_bol = 
+      if local_pos.Lexing.pos_lnum <= 1 then
+        globpos.Lexing.pos_bol
+      else
+        local_pos.Lexing.pos_bol + globpos.Lexing.pos_cnum;
+  Lexing.pos_cnum = local_pos.Lexing.pos_cnum + globpos.Lexing.pos_cnum
+};
+
+value adjust_loc gpos (p1, p2) =
+   (adjust_pos gpos p1, adjust_pos gpos p2)
+;
+
+(* Note: in the following, the "let nloc = floc loc in" is necessary
+   in order to force evaluation order: the "floc" function has a side-effect
+   that changes all locations produced but the first one into ghost locations *)
+
 value rec patt floc sh =
   self where rec self =
     fun
-    [ PaAcc loc x1 x2 -> PaAcc (floc loc) (self x1) (self x2)
-    | PaAli loc x1 x2 -> PaAli (floc loc) (self x1) (self x2)
-    | PaAnt loc x1 ->
-        patt (fun (p1, p2) -> (sh + fst loc + p1, sh + fst loc + p2)) 0 x1
-    | PaAny loc -> PaAny (floc loc)
-    | PaApp loc x1 x2 -> PaApp (floc loc) (self x1) (self x2)
-    | PaArr loc x1 -> PaArr (floc loc) (List.map self x1)
-    | PaChr loc x1 -> PaChr (floc loc) x1
-    | PaInt loc x1 -> PaInt (floc loc) x1
-    | PaInt32 loc x1 -> PaInt32 (floc loc) x1
-    | PaInt64 loc x1 -> PaInt64 (floc loc) x1
-    | PaNativeInt loc x1 -> PaNativeInt (floc loc) x1
-    | PaFlo loc x1 -> PaFlo (floc loc) x1
-    | PaLab loc x1 x2 -> PaLab (floc loc) x1 (option_map self x2)
-    | PaLid loc x1 -> PaLid (floc loc) x1
+    [ PaAcc loc x1 x2 -> let nloc = floc loc in PaAcc nloc (self x1) (self x2)
+    | PaAli loc x1 x2 -> let nloc = floc loc in PaAli nloc (self x1) (self x2)
+    | PaAnt loc x1 -> (* Note that antiquotations are parsed by the OCaml parser, passing line numbers and begs of lines *)
+        patt (fun lloc -> adjust_loc (adjust_pos sh (fst loc)) (linearize lloc)) zero_loc x1
+    | PaAny loc -> let nloc = floc loc in PaAny nloc
+    | PaApp loc x1 x2 -> let nloc = floc loc in PaApp nloc (self x1) (self x2)
+    | PaArr loc x1 -> let nloc = floc loc in PaArr nloc (List.map self x1)
+    | PaChr loc x1 -> let nloc = floc loc in PaChr nloc x1
+    | PaInt loc x1 -> let nloc = floc loc in PaInt nloc x1
+    | PaInt32 loc x1 -> let nloc = floc loc in PaInt32 nloc x1
+    | PaInt64 loc x1 -> let nloc = floc loc in PaInt64 nloc x1
+    | PaNativeInt loc x1 -> let nloc = floc loc in PaNativeInt nloc x1
+    | PaFlo loc x1 -> let nloc = floc loc in PaFlo nloc x1
+    | PaLab loc x1 x2 -> let nloc = floc loc in PaLab nloc x1 (option_map self x2)
+    | PaLid loc x1 -> let nloc = floc loc in PaLid nloc x1
     | PaOlb loc x1 x2 ->
-        PaOlb (floc loc) x1
+        let nloc = floc loc in
+        PaOlb nloc x1
           (option_map
              (fun (x1, x2) -> (self x1, option_map (expr floc sh) x2)) x2)
-    | PaOrp loc x1 x2 -> PaOrp (floc loc) (self x1) (self x2)
-    | PaRng loc x1 x2 -> PaRng (floc loc) (self x1) (self x2)
+    | PaOrp loc x1 x2 -> let nloc = floc loc in PaOrp nloc (self x1) (self x2)
+    | PaRng loc x1 x2 -> let nloc = floc loc in PaRng nloc (self x1) (self x2)
     | PaRec loc x1 ->
-        PaRec (floc loc) (List.map (fun (x1, x2) -> (self x1, self x2)) x1)
-    | PaStr loc x1 -> PaStr (floc loc) x1
-    | PaTup loc x1 -> PaTup (floc loc) (List.map self x1)
-    | PaTyc loc x1 x2 -> PaTyc (floc loc) (self x1) (ctyp floc sh x2)
-    | PaTyp loc x1 -> PaTyp (floc loc) x1
-    | PaUid loc x1 -> PaUid (floc loc) x1
-    | PaVrn loc x1 -> PaVrn (floc loc) x1 ]
+        let nloc = floc loc in PaRec nloc (List.map (fun (x1, x2) -> (self x1, self x2)) x1)
+    | PaStr loc x1 -> let nloc = floc loc in PaStr nloc x1
+    | PaTup loc x1 -> let nloc = floc loc in PaTup nloc (List.map self x1)
+    | PaTyc loc x1 x2 -> let nloc = floc loc in PaTyc nloc (self x1) (ctyp floc sh x2)
+    | PaTyp loc x1 -> let nloc = floc loc in PaTyp nloc x1
+    | PaUid loc x1 -> let nloc = floc loc in PaUid nloc x1
+    | PaVrn loc x1 -> let nloc = floc loc in PaVrn nloc x1 ]
 and expr floc sh =
   self where rec self =
     fun
-    [ ExAcc loc x1 x2 -> ExAcc (floc loc) (self x1) (self x2)
-    | ExAnt loc x1 ->
-        expr (fun (p1, p2) -> (sh + fst loc + p1, sh + fst loc + p2)) 0 x1
-    | ExApp loc x1 x2 -> ExApp (floc loc) (self x1) (self x2)
-    | ExAre loc x1 x2 -> ExAre (floc loc) (self x1) (self x2)
-    | ExArr loc x1 -> ExArr (floc loc) (List.map self x1)
-    | ExAsf loc -> ExAsf (floc loc)
-    | ExAsr loc x1 -> ExAsr (floc loc) (self x1)
-    | ExAss loc x1 x2 -> ExAss (floc loc) (self x1) (self x2)
-    | ExChr loc x1 -> ExChr (floc loc) x1
+    [ ExAcc loc x1 x2 -> let nloc = floc loc in ExAcc nloc (self x1) (self x2)
+    | ExAnt loc x1 -> (* Note that antiquotations are parsed by the OCaml parser, passing line numbers and begs of lines *)
+        expr (fun lloc -> (adjust_loc (adjust_pos sh (fst loc)) (linearize lloc)))
+             zero_loc x1
+    | ExApp loc x1 x2 -> let nloc = floc loc in ExApp nloc (self x1) (self x2)
+    | ExAre loc x1 x2 -> let nloc = floc loc in ExAre nloc (self x1) (self x2)
+    | ExArr loc x1 -> let nloc = floc loc in ExArr nloc (List.map self x1)
+    | ExAsf loc -> let nloc = floc loc in ExAsf nloc
+    | ExAsr loc x1 -> let nloc = floc loc in ExAsr nloc (self x1)
+    | ExAss loc x1 x2 -> let nloc = floc loc in ExAss nloc (self x1) (self x2)
+    | ExChr loc x1 -> let nloc = floc loc in ExChr nloc x1
     | ExCoe loc x1 x2 x3 ->
-        ExCoe (floc loc) (self x1) (option_map (ctyp floc sh) x2)
+        let nloc = floc loc in
+        ExCoe nloc (self x1) (option_map (ctyp floc sh) x2)
           (ctyp floc sh x3)
-    | ExFlo loc x1 -> ExFlo (floc loc) x1
+    | ExFlo loc x1 -> let nloc = floc loc in ExFlo nloc x1
     | ExFor loc x1 x2 x3 x4 x5 ->
-        ExFor (floc loc) x1 (self x2) (self x3) x4 (List.map self x5)
+        let nloc = floc loc in ExFor nloc x1 (self x2) (self x3) x4 (List.map self x5)
     | ExFun loc x1 ->
-        ExFun (floc loc)
+        let nloc = floc loc in
+        ExFun nloc
           (List.map
              (fun (x1, x2, x3) ->
                 (patt floc sh x1, option_map self x2, self x3))
              x1)
-    | ExIfe loc x1 x2 x3 -> ExIfe (floc loc) (self x1) (self x2) (self x3)
-    | ExInt loc x1 -> ExInt (floc loc) x1
-    | ExInt32 loc x1 -> ExInt32 (floc loc) x1
-    | ExInt64 loc x1 -> ExInt64 (floc loc) x1
-    | ExNativeInt loc x1 -> ExNativeInt (floc loc) x1
-    | ExLab loc x1 x2 -> ExLab (floc loc) x1 (option_map self x2)
-    | ExLaz loc x1 -> ExLaz (floc loc) (self x1)
+    | ExIfe loc x1 x2 x3 -> let nloc = floc loc in ExIfe nloc (self x1) (self x2) (self x3)
+    | ExInt loc x1 -> let nloc = floc loc in ExInt nloc x1
+    | ExInt32 loc x1 -> let nloc = floc loc in ExInt32 nloc x1
+    | ExInt64 loc x1 -> let nloc = floc loc in ExInt64 nloc x1
+    | ExNativeInt loc x1 -> let nloc = floc loc in ExNativeInt nloc x1
+    | ExLab loc x1 x2 -> let nloc = floc loc in ExLab nloc x1 (option_map self x2)
+    | ExLaz loc x1 -> let nloc = floc loc in ExLaz nloc (self x1)
     | ExLet loc x1 x2 x3 ->
-        ExLet (floc loc) x1
+        let nloc = floc loc in
+        ExLet nloc x1
           (List.map (fun (x1, x2) -> (patt floc sh x1, self x2)) x2) (self x3)
-    | ExLid loc x1 -> ExLid (floc loc) x1
+    | ExLid loc x1 -> let nloc = floc loc in ExLid nloc x1
     | ExLmd loc x1 x2 x3 ->
-        ExLmd (floc loc) x1 (module_expr floc sh x2) (self x3)
+        let nloc = floc loc in ExLmd nloc x1 (module_expr floc sh x2) (self x3)
     | ExMat loc x1 x2 ->
-        ExMat (floc loc) (self x1)
+        let nloc = floc loc in
+        ExMat nloc (self x1)
           (List.map
              (fun (x1, x2, x3) ->
                 (patt floc sh x1, option_map self x2, self x3))
              x2)
-    | ExNew loc x1 -> ExNew (floc loc) x1
-    | ExOlb loc x1 x2 -> ExOlb (floc loc) x1 (option_map self x2)
+    | ExNew loc x1 -> let nloc = floc loc in ExNew nloc x1
+    | ExObj loc x1 x2 ->
+        let nloc = floc loc in ExObj nloc (option_map (patt floc sh) x1)
+          (List.map (class_str_item floc sh) x2)
+    | ExOlb loc x1 x2 -> let nloc = floc loc in ExOlb nloc x1 (option_map self x2)
     | ExOvr loc x1 ->
-        ExOvr (floc loc) (List.map (fun (x1, x2) -> (x1, self x2)) x1)
+        let nloc = floc loc in
+        ExOvr nloc (List.map (fun (x1, x2) -> (x1, self x2)) x1)
     | ExRec loc x1 x2 ->
-        ExRec (floc loc)
+        let nloc = floc loc in
+        ExRec nloc
           (List.map (fun (x1, x2) -> (patt floc sh x1, self x2)) x1)
           (option_map self x2)
-    | ExSeq loc x1 -> ExSeq (floc loc) (List.map self x1)
-    | ExSnd loc x1 x2 -> ExSnd (floc loc) (self x1) x2
-    | ExSte loc x1 x2 -> ExSte (floc loc) (self x1) (self x2)
-    | ExStr loc x1 -> ExStr (floc loc) x1
+    | ExSeq loc x1 -> let nloc = floc loc in ExSeq nloc (List.map self x1)
+    | ExSnd loc x1 x2 -> let nloc = floc loc in ExSnd nloc (self x1) x2
+    | ExSte loc x1 x2 -> let nloc = floc loc in ExSte nloc (self x1) (self x2)
+    | ExStr loc x1 -> let nloc = floc loc in ExStr nloc x1
     | ExTry loc x1 x2 ->
-        ExTry (floc loc) (self x1)
+        let nloc = floc loc in
+        ExTry nloc (self x1)
           (List.map
              (fun (x1, x2, x3) ->
                 (patt floc sh x1, option_map self x2, self x3))
              x2)
-    | ExTup loc x1 -> ExTup (floc loc) (List.map self x1)
-    | ExTyc loc x1 x2 -> ExTyc (floc loc) (self x1) (ctyp floc sh x2)
-    | ExUid loc x1 -> ExUid (floc loc) x1
-    | ExVrn loc x1 -> ExVrn (floc loc) x1
-    | ExWhi loc x1 x2 -> ExWhi (floc loc) (self x1) (List.map self x2) ]
+    | ExTup loc x1 -> let nloc = floc loc in ExTup nloc (List.map self x1)
+    | ExTyc loc x1 x2 -> let nloc = floc loc in ExTyc nloc (self x1) (ctyp floc sh x2)
+    | ExUid loc x1 -> let nloc = floc loc in ExUid nloc x1
+    | ExVrn loc x1 -> let nloc = floc loc in ExVrn nloc x1
+    | ExWhi loc x1 x2 -> let nloc = floc loc in ExWhi nloc (self x1) (List.map self x2) ]
 and module_type floc sh =
   self where rec self =
     fun
-    [ MtAcc loc x1 x2 -> MtAcc (floc loc) (self x1) (self x2)
-    | MtApp loc x1 x2 -> MtApp (floc loc) (self x1) (self x2)
-    | MtFun loc x1 x2 x3 -> MtFun (floc loc) x1 (self x2) (self x3)
-    | MtLid loc x1 -> MtLid (floc loc) x1
-    | MtQuo loc x1 -> MtQuo (floc loc) x1
-    | MtSig loc x1 -> MtSig (floc loc) (List.map (sig_item floc sh) x1)
-    | MtUid loc x1 -> MtUid (floc loc) x1
+    [ MtAcc loc x1 x2 -> let nloc = floc loc in MtAcc nloc (self x1) (self x2)
+    | MtApp loc x1 x2 -> let nloc = floc loc in MtApp nloc (self x1) (self x2)
+    | MtFun loc x1 x2 x3 -> let nloc = floc loc in MtFun nloc x1 (self x2) (self x3)
+    | MtLid loc x1 -> let nloc = floc loc in MtLid nloc x1
+    | MtQuo loc x1 -> let nloc = floc loc in MtQuo nloc x1
+    | MtSig loc x1 -> let nloc = floc loc in MtSig nloc (List.map (sig_item floc sh) x1)
+    | MtUid loc x1 -> let nloc = floc loc in MtUid nloc x1
     | MtWit loc x1 x2 ->
-        MtWit (floc loc) (self x1) (List.map (with_constr floc sh) x2) ]
+        let nloc = floc loc in MtWit nloc (self x1) (List.map (with_constr floc sh) x2) ]
 and sig_item floc sh =
   self where rec self =
     fun
     [ SgCls loc x1 ->
-        SgCls (floc loc) (List.map (class_infos class_type floc sh) x1)
+        let nloc = floc loc in SgCls nloc (List.map (class_infos class_type floc sh) x1)
     | SgClt loc x1 ->
-        SgClt (floc loc) (List.map (class_infos class_type floc sh) x1)
-    | SgDcl loc x1 -> SgDcl (floc loc) (List.map self x1)
-    | SgDir loc x1 x2 -> SgDir (floc loc) x1 x2
-    | SgExc loc x1 x2 -> SgExc (floc loc) x1 (List.map (ctyp floc sh) x2)
-    | SgExt loc x1 x2 x3 -> SgExt (floc loc) x1 (ctyp floc sh x2) x3
-    | SgInc loc x1 -> SgInc (floc loc) (module_type floc sh x1)
-    | SgMod loc x1 x2 -> SgMod (floc loc) x1 (module_type floc sh x2)
+        let nloc = floc loc in SgClt nloc (List.map (class_infos class_type floc sh) x1)
+    | SgDcl loc x1 -> let nloc = floc loc in SgDcl nloc (List.map self x1)
+    | SgDir loc x1 x2 -> let nloc = floc loc in SgDir nloc x1 x2
+    | SgExc loc x1 x2 -> let nloc = floc loc in SgExc nloc x1 (List.map (ctyp floc sh) x2)
+    | SgExt loc x1 x2 x3 -> let nloc = floc loc in SgExt nloc x1 (ctyp floc sh x2) x3
+    | SgInc loc x1 -> let nloc = floc loc in SgInc nloc (module_type floc sh x1)
+    | SgMod loc x1 x2 -> let nloc = floc loc in SgMod nloc x1 (module_type floc sh x2)
     | SgRecMod loc xxs
-        -> SgRecMod (floc loc) (List.map (fun (x1,x2) -> (x1, (module_type floc sh x2))) xxs)
-    | SgMty loc x1 x2 -> SgMty (floc loc) x1 (module_type floc sh x2)
-    | SgOpn loc x1 -> SgOpn (floc loc) x1
+        -> let nloc = floc loc in SgRecMod nloc (List.map (fun (x1,x2) -> (x1, (module_type floc sh x2))) xxs)
+    | SgMty loc x1 x2 -> let nloc = floc loc in SgMty nloc x1 (module_type floc sh x2)
+    | SgOpn loc x1 -> let nloc = floc loc in SgOpn nloc x1
     | SgTyp loc x1 ->
-        SgTyp (floc loc)
+        let nloc = floc loc in
+        SgTyp nloc
           (List.map
              (fun ((loc, x1), x2, x3, x4) ->
                 ((floc loc, x1), x2, ctyp floc sh x3,
@@ -198,42 +291,44 @@ and sig_item floc sh =
                    x4))
              x1)
     | SgUse loc x1 x2 -> SgUse loc x1 x2
-    | SgVal loc x1 x2 -> SgVal (floc loc) x1 (ctyp floc sh x2) ]
+    | SgVal loc x1 x2 -> let nloc = floc loc in SgVal nloc x1 (ctyp floc sh x2) ]
 and with_constr floc sh =
   self where rec self =
     fun
-    [ WcTyp loc x1 x2 x3 -> WcTyp (floc loc) x1 x2 (ctyp floc sh x3)
-    | WcMod loc x1 x2 -> WcMod (floc loc) x1 (module_expr floc sh x2) ]
+    [ WcTyp loc x1 x2 x3 -> let nloc = floc loc in WcTyp nloc x1 x2 (ctyp floc sh x3)
+    | WcMod loc x1 x2 -> let nloc = floc loc in WcMod nloc x1 (module_expr floc sh x2) ]
 and module_expr floc sh =
   self where rec self =
     fun
-    [ MeAcc loc x1 x2 -> MeAcc (floc loc) (self x1) (self x2)
-    | MeApp loc x1 x2 -> MeApp (floc loc) (self x1) (self x2)
+    [ MeAcc loc x1 x2 -> let nloc = floc loc in MeAcc nloc (self x1) (self x2)
+    | MeApp loc x1 x2 -> let nloc = floc loc in MeApp nloc (self x1) (self x2)
     | MeFun loc x1 x2 x3 ->
-        MeFun (floc loc) x1 (module_type floc sh x2) (self x3)
-    | MeStr loc x1 -> MeStr (floc loc) (List.map (str_item floc sh) x1)
-    | MeTyc loc x1 x2 -> MeTyc (floc loc) (self x1) (module_type floc sh x2)
-    | MeUid loc x1 -> MeUid (floc loc) x1 ]
+        let nloc = floc loc in
+        MeFun nloc x1 (module_type floc sh x2) (self x3)
+    | MeStr loc x1 -> let nloc = floc loc in MeStr nloc (List.map (str_item floc sh) x1)
+    | MeTyc loc x1 x2 -> let nloc = floc loc in MeTyc nloc (self x1) (module_type floc sh x2)
+    | MeUid loc x1 -> let nloc = floc loc in MeUid nloc x1 ]
 and str_item floc sh =
   self where rec self =
     fun
     [ StCls loc x1 ->
-        StCls (floc loc) (List.map (class_infos class_expr floc sh) x1)
+        let nloc = floc loc in StCls nloc (List.map (class_infos class_expr floc sh) x1)
     | StClt loc x1 ->
-        StClt (floc loc) (List.map (class_infos class_type floc sh) x1)
-    | StDcl loc x1 -> StDcl (floc loc) (List.map self x1)
-    | StDir loc x1 x2 -> StDir (floc loc) x1 x2
-    | StExc loc x1 x2 x3 -> StExc (floc loc) x1 (List.map (ctyp floc sh) x2) x3
-    | StExp loc x1 -> StExp (floc loc) (expr floc sh x1)
-    | StExt loc x1 x2 x3 -> StExt (floc loc) x1 (ctyp floc sh x2) x3
-    | StInc loc x1 -> StInc (floc loc) (module_expr floc sh x1)
-    | StMod loc x1 x2 -> StMod (floc loc) x1 (module_expr floc sh x2)
+        let nloc = floc loc in StClt nloc (List.map (class_infos class_type floc sh) x1)
+    | StDcl loc x1 -> let nloc = floc loc in StDcl nloc (List.map self x1)
+    | StDir loc x1 x2 -> let nloc = floc loc in StDir nloc x1 x2
+    | StExc loc x1 x2 x3 -> let nloc = floc loc in StExc nloc x1 (List.map (ctyp floc sh) x2) x3
+    | StExp loc x1 -> let nloc = floc loc in StExp nloc (expr floc sh x1)
+    | StExt loc x1 x2 x3 -> let nloc = floc loc in StExt nloc x1 (ctyp floc sh x2) x3
+    | StInc loc x1 -> let nloc = floc loc in StInc nloc (module_expr floc sh x1)
+    | StMod loc x1 x2 -> let nloc = floc loc in StMod nloc x1 (module_expr floc sh x2)
     | StRecMod loc nmtmes ->
-        StRecMod (floc loc) (List.map (fun (n, mt, me) -> (n, module_type floc sh mt, module_expr floc sh me)) nmtmes)
-    | StMty loc x1 x2 -> StMty (floc loc) x1 (module_type floc sh x2)
-    | StOpn loc x1 -> StOpn (floc loc) x1
+        let nloc = floc loc in StRecMod nloc (List.map (fun (n, mt, me) -> (n, module_type floc sh mt, module_expr floc sh me)) nmtmes)
+    | StMty loc x1 x2 -> let nloc = floc loc in StMty nloc x1 (module_type floc sh x2)
+    | StOpn loc x1 -> let nloc = floc loc in StOpn nloc x1
     | StTyp loc x1 ->
-        StTyp (floc loc)
+        let nloc = floc loc in
+        StTyp nloc
           (List.map
              (fun ((loc, x1), x2, x3, x4) ->
                 ((floc loc, x1), x2, ctyp floc sh x3,
@@ -242,48 +337,50 @@ and str_item floc sh =
              x1)
     | StUse loc x1 x2 -> StUse loc x1 x2
     | StVal loc x1 x2 ->
-        StVal (floc loc) x1
+        let nloc = floc loc in StVal nloc x1
           (List.map (fun (x1, x2) -> (patt floc sh x1, expr floc sh x2)) x2) ]
 and class_type floc sh =
   self where rec self =
     fun
-    [ CtCon loc x1 x2 -> CtCon (floc loc) x1 (List.map (ctyp floc sh) x2)
-    | CtFun loc x1 x2 -> CtFun (floc loc) (ctyp floc sh x1) (self x2)
+    [ CtCon loc x1 x2 -> let nloc = floc loc in CtCon nloc x1 (List.map (ctyp floc sh) x2)
+    | CtFun loc x1 x2 -> let nloc = floc loc in CtFun nloc (ctyp floc sh x1) (self x2)
     | CtSig loc x1 x2 ->
-        CtSig (floc loc) (option_map (ctyp floc sh) x1)
+        let nloc = floc loc in
+        CtSig nloc (option_map (ctyp floc sh) x1)
           (List.map (class_sig_item floc sh) x2) ]
 and class_sig_item floc sh =
   self where rec self =
     fun
-    [ CgCtr loc x1 x2 -> CgCtr (floc loc) (ctyp floc sh x1) (ctyp floc sh x2)
-    | CgDcl loc x1 -> CgDcl (floc loc) (List.map (class_sig_item floc sh) x1)
-    | CgInh loc x1 -> CgInh (floc loc) (class_type floc sh x1)
-    | CgMth loc x1 x2 x3 -> CgMth (floc loc) x1 x2 (ctyp floc sh x3)
-    | CgVal loc x1 x2 x3 -> CgVal (floc loc) x1 x2 (ctyp floc sh x3)
-    | CgVir loc x1 x2 x3 -> CgVir (floc loc) x1 x2 (ctyp floc sh x3) ]
+    [ CgCtr loc x1 x2 -> let nloc = floc loc in CgCtr nloc (ctyp floc sh x1) (ctyp floc sh x2)
+    | CgDcl loc x1 -> let nloc = floc loc in CgDcl nloc (List.map (class_sig_item floc sh) x1)
+    | CgInh loc x1 -> let nloc = floc loc in CgInh nloc (class_type floc sh x1)
+    | CgMth loc x1 x2 x3 -> let nloc = floc loc in CgMth nloc x1 x2 (ctyp floc sh x3)
+    | CgVal loc x1 x2 x3 -> let nloc = floc loc in CgVal nloc x1 x2 (ctyp floc sh x3)
+    | CgVir loc x1 x2 x3 -> let nloc = floc loc in CgVir nloc x1 x2 (ctyp floc sh x3) ]
 and class_expr floc sh =
   self where rec self =
     fun
-    [ CeApp loc x1 x2 -> CeApp (floc loc) (self x1) (expr floc sh x2)
-    | CeCon loc x1 x2 -> CeCon (floc loc) x1 (List.map (ctyp floc sh) x2)
-    | CeFun loc x1 x2 -> CeFun (floc loc) (patt floc sh x1) (self x2)
+    [ CeApp loc x1 x2 -> let nloc = floc loc in CeApp nloc (self x1) (expr floc sh x2)
+    | CeCon loc x1 x2 -> let nloc = floc loc in CeCon nloc x1 (List.map (ctyp floc sh) x2)
+    | CeFun loc x1 x2 -> let nloc = floc loc in CeFun nloc (patt floc sh x1) (self x2)
     | CeLet loc x1 x2 x3 ->
-        CeLet (floc loc) x1
+        let nloc = floc loc in
+        CeLet nloc x1
           (List.map (fun (x1, x2) -> (patt floc sh x1, expr floc sh x2)) x2)
           (self x3)
     | CeStr loc x1 x2 ->
-        CeStr (floc loc) (option_map (patt floc sh) x1)
+        let nloc = floc loc in CeStr nloc (option_map (patt floc sh) x1)
           (List.map (class_str_item floc sh) x2)
-    | CeTyc loc x1 x2 -> CeTyc (floc loc) (self x1) (class_type floc sh x2) ]
+    | CeTyc loc x1 x2 -> let nloc = floc loc in CeTyc nloc (self x1) (class_type floc sh x2) ]
 and class_str_item floc sh =
   self where rec self =
     fun
-    [ CrCtr loc x1 x2 -> CrCtr (floc loc) (ctyp floc sh x1) (ctyp floc sh x2)
-    | CrDcl loc x1 -> CrDcl (floc loc) (List.map (class_str_item floc sh) x1)
-    | CrInh loc x1 x2 -> CrInh (floc loc) (class_expr floc sh x1) x2
-    | CrIni loc x1 -> CrIni (floc loc) (expr floc sh x1)
+    [ CrCtr loc x1 x2 -> let nloc = floc loc in CrCtr nloc (ctyp floc sh x1) (ctyp floc sh x2)
+    | CrDcl loc x1 -> let nloc = floc loc in CrDcl nloc (List.map (class_str_item floc sh) x1)
+    | CrInh loc x1 x2 -> let nloc = floc loc in CrInh nloc (class_expr floc sh x1) x2
+    | CrIni loc x1 -> let nloc = floc loc in CrIni nloc (expr floc sh x1)
     | CrMth loc x1 x2 x3 x4 ->
-        CrMth (floc loc) x1 x2 (expr floc sh x3) (option_map (ctyp floc sh) x4)
-    | CrVal loc x1 x2 x3 -> CrVal (floc loc) x1 x2 (expr floc sh x3)
-    | CrVir loc x1 x2 x3 -> CrVir (floc loc) x1 x2 (ctyp floc sh x3) ]
+        let nloc = floc loc in CrMth nloc x1 x2 (expr floc sh x3) (option_map (ctyp floc sh) x4)
+    | CrVal loc x1 x2 x3 -> let nloc = floc loc in CrVal nloc x1 x2 (expr floc sh x3)
+    | CrVir loc x1 x2 x3 -> let nloc = floc loc in CrVir nloc x1 x2 (ctyp floc sh x3) ]
 ;
diff --git a/camlp4/camlp4/reloc.mli b/camlp4/camlp4/reloc.mli
index d1a09a4e1f..637c7558b8 100644
--- a/camlp4/camlp4/reloc.mli
+++ b/camlp4/camlp4/reloc.mli
@@ -12,5 +12,9 @@
 
 (* $Id$ *)
 
-value patt : (MLast.loc -> MLast.loc) -> int -> MLast.patt -> MLast.patt;
-value expr : (MLast.loc -> MLast.loc) -> int -> MLast.expr -> MLast.expr;
+value zero_loc : Lexing.position;
+value shift_pos : int -> Lexing.position -> Lexing.position;
+value adjust_loc : Lexing.position -> MLast.loc -> MLast.loc;
+value linearize : MLast.loc -> MLast.loc;
+value patt : (MLast.loc -> MLast.loc) -> Lexing.position -> MLast.patt -> MLast.patt;
+value expr : (MLast.loc -> MLast.loc) -> Lexing.position -> MLast.expr -> MLast.expr;
diff --git a/camlp4/compile/compile.ml b/camlp4/compile/compile.ml
index 5fff04b27d..af478774f7 100644
--- a/camlp4/compile/compile.ml
+++ b/camlp4/compile/compile.ml
@@ -8,7 +8,10 @@ open Gramext;
 value strict_parsing = ref False;
 value keywords = ref [];
 
-value loc = (0, 0);
+value loc =
+  let nowhere = 
+    {(Lexing.dummy_pos) with Lexing.pos_lnum = 1; Lexing.pos_cnum = 0 } in
+  (nowhere,nowhere);
 
 (* Watch the segmentation faults here! the compiled file must have been
    loaded in camlp4 with the option pa_extend.cmo -meta_action. *)
@@ -101,7 +104,7 @@ value nth_patt_of_act (e, n) =
   let patt_list =
     loop e where rec loop =
       fun
-      [ <:expr< fun (loc : (int * int)) -> $_$ >> -> []
+      [ <:expr< fun (loc : (Lexing.position * Lexing.position)) -> $_$ >> -> []
       | <:expr< fun ($p$ : $_$) -> $e$ >> -> [p :: loop e]
       | <:expr< fun $p$ -> $e$ >> -> [p :: loop e]
       | _ -> failwith "nth_patt_of_act" ]
@@ -111,14 +114,14 @@ value nth_patt_of_act (e, n) =
 
 value rec last_patt_of_act =
   fun
-  [ <:expr< fun ($p$ : $_$) (loc : (int * int)) -> $_$ >> -> p
+  [ <:expr< fun ($p$ : $_$) (loc : (Lexing.position * Lexing.position)) -> $_$ >> -> p
   | <:expr< fun $_$ -> $e$ >> -> last_patt_of_act e
   | _ -> failwith "last_patt_of_act" ]
 ;
 
 value rec final_action =
   fun
-  [ <:expr< fun (loc : (int * int)) -> ($e$ : $_$) >> -> e
+  [ <:expr< fun (loc : (Lexing.position * Lexing.position)) -> ($e$ : $_$) >> -> e
   | <:expr< fun $_$ -> $e$ >> -> final_action e
   | _ -> failwith "final_action" ]
 ;
@@ -560,7 +563,10 @@ value compile () =
         $expr_list list$
     >>
   in
-  let loc = (1, 1) in
+  let loc =
+    let l1 = 
+      {(Lexing.dummy_pos) with Lexing.pos_lnum = 1; Lexing.pos_cnum = 1 } in
+    (l1,l1) in
   ([(si1, loc); (si2, loc)], False)
 ;
 
diff --git a/camlp4/etc/.depend b/camlp4/etc/.depend
index 6349726235..9e7c7c07cd 100644
--- a/camlp4/etc/.depend
+++ b/camlp4/etc/.depend
@@ -11,6 +11,8 @@ pa_ifdef.cmo: ../camlp4/mLast.cmi ../camlp4/pcaml.cmi
 pa_ifdef.cmx: ../camlp4/mLast.cmi ../camlp4/pcaml.cmx 
 pa_lefteval.cmo: ../camlp4/mLast.cmi ../camlp4/pcaml.cmi 
 pa_lefteval.cmx: ../camlp4/mLast.cmi ../camlp4/pcaml.cmx 
+pa_lispr.cmo: ../camlp4/mLast.cmi ../camlp4/pcaml.cmi ../camlp4/reloc.cmi 
+pa_lispr.cmx: ../camlp4/mLast.cmi ../camlp4/pcaml.cmx ../camlp4/reloc.cmx 
 pa_lisp.cmo: ../camlp4/mLast.cmi ../camlp4/pcaml.cmi 
 pa_lisp.cmx: ../camlp4/mLast.cmi ../camlp4/pcaml.cmx 
 pa_lispr.cmo: ../camlp4/mLast.cmi ../camlp4/pcaml.cmi 
@@ -31,10 +33,8 @@ pa_op.cmo: ../camlp4/mLast.cmi ../camlp4/pcaml.cmi
 pa_op.cmx: ../camlp4/mLast.cmi ../camlp4/pcaml.cmx 
 pa_ru.cmo: ../camlp4/mLast.cmi ../camlp4/pcaml.cmi 
 pa_ru.cmx: ../camlp4/mLast.cmi ../camlp4/pcaml.cmx 
-pa_scheme.cmo: ../camlp4/mLast.cmi ../camlp4/pcaml.cmi 
-pa_scheme.cmx: ../camlp4/mLast.cmi ../camlp4/pcaml.cmx 
-pa_schemer.cmo: ../camlp4/mLast.cmi ../camlp4/pcaml.cmi 
-pa_schemer.cmx: ../camlp4/mLast.cmi ../camlp4/pcaml.cmx 
+pa_schemer.cmo: ../camlp4/mLast.cmi ../camlp4/pcaml.cmi ../camlp4/reloc.cmi 
+pa_schemer.cmx: ../camlp4/mLast.cmi ../camlp4/pcaml.cmx ../camlp4/reloc.cmx 
 pa_sml.cmo: ../camlp4/mLast.cmi ../camlp4/pcaml.cmi 
 pa_sml.cmx: ../camlp4/mLast.cmi ../camlp4/pcaml.cmx 
 parserify.cmo: ../camlp4/mLast.cmi parserify.cmi 
diff --git a/camlp4/etc/Makefile b/camlp4/etc/Makefile
index 9b8fc705f7..0bbc184fc0 100644
--- a/camlp4/etc/Makefile
+++ b/camlp4/etc/Makefile
@@ -4,18 +4,17 @@ include ../config/Makefile
 
 INCLUDES=-I ../camlp4 -I ../boot -I $(OTOP)/lex
 OCAMLCFLAGS=-warn-error A $(INCLUDES)
-OBJS=q_phony.cmo pa_o.cmo pa_op.cmo pa_oop.cmo pa_ru.cmo pa_format.cmo \
-     pa_olabl.cmo pa_sml.cmo pa_lisp.cmo pa_scheme.cmo pa_extfold.cmo \
-     pa_extfun.cmo pa_fstream.cmo pa_lefteval.cmo pa_ifdef.cmo pr_r.cmo \
-     pr_rp.cmo pr_o.cmo pr_op.cmo pr_scheme.cmo pr_schemep.cmo \
-     pr_extend.cmo pr_extfun.cmo pr_null.cmo pr_depend.cmo
+# pa_list, pa_scheme dont work any longer because of locations OBJS=q_phony.cmo pa_o.cmo pa_op.cmo pa_oop.cmo pa_ru.cmo pa_format.cmo pa_olabl.cmo pa_sml.cmo pa_lisp.cmo pa_scheme.cmo pa_extfold.cmo pa_extfun.cmo pa_fstream.cmo pa_lefteval.cmo pa_ifdef.cmo pr_r.cmo pr_rp.cmo pr_o.cmo pr_op.cmo pr_scheme.cmo pr_schemep.cmo pr_extend.cmo pr_extfun.cmo pr_null.cmo pr_depend.cmo
+OBJS=q_phony.cmo pa_o.cmo pa_op.cmo pa_oop.cmo pa_ru.cmo pa_format.cmo pa_olabl.cmo pa_sml.cmo pa_extfold.cmo pa_extfun.cmo pa_fstream.cmo pa_lefteval.cmo pa_ifdef.cmo pr_r.cmo pr_rp.cmo pr_o.cmo pr_op.cmo pr_scheme.cmo pr_schemep.cmo pr_extend.cmo pr_extfun.cmo pr_null.cmo pr_depend.cmo
+
 OBJSX=$(OBJS:.cmo=.cmx)
 INTF=pa_o.cmi
 CAMLP4OM=pa_o.cmo pa_op.cmo ../meta/pr_dump.cmo
 CAMLP4OMX=$(CAMLP4OM:.cmo=.cmx)
 CAMLP4SCHM=pa_scheme.cmo ../meta/pr_dump.cmo
 SHELL=/bin/sh
-COUT=$(OBJS) camlp4o$(EXE) camlp4sch$(EXE)
+# camlp4schm is broken COUT=$(OBJS) camlp4o$(EXE) #camlp4sch$(EXE)
+COUT=$(OBJS) camlp4o$(EXE)
 COPT=$(OBJSX) camlp4o.opt
 
 all: $(COUT) mkcamlp4.sh
@@ -100,7 +99,8 @@ install:
 	cp $(OBJS) "$(LIBDIR)/camlp4/."
 	cp $(INTF) "$(LIBDIR)/camlp4/."
 	cp lib.sml "$(LIBDIR)/camlp4/."
-	cp camlp4o$(EXE) camlp4sch$(EXE) "$(BINDIR)/."
+#	cp camlp4o$(EXE) camlp4sch$(EXE) "$(BINDIR)/."
+	cp camlp4o$(EXE) "$(BINDIR)/."
 	if test -f camlp4o.opt; then cp camlp4o.opt "$(BINDIR)/camlp4o.opt$(EXE)"; cp $(OBJSX) $(OBJSX:.cmx=.o) "$(LIBDIR)/camlp4/."; fi
 	cp mkcamlp4.sh "$(BINDIR)/mkcamlp4"
 	chmod a+x "$(BINDIR)/mkcamlp4"
diff --git a/camlp4/etc/pa_lispr.ml b/camlp4/etc/pa_lispr.ml
index fb150e2096..0f6f88a965 100644
--- a/camlp4/etc/pa_lispr.ml
+++ b/camlp4/etc/pa_lispr.ml
@@ -76,16 +76,20 @@ value quote =
   | [: `x; s :] -> char_or_quote_id x s ]
 ;
 
-value rec lexer kwt =
+value rec lexer kwt fname lnum bolpos =
+  let make_pos p =
+    {Lexing.pos_fname = fname.val; Lexing.pos_lnum = lnum.val;
+     Lexing.pos_bol = bolpos.val; Lexing.pos_cnum = p} in
+  let mkloc (bp, ep) = (make_pos bp, make_pos ep) in
   parser bp
-  [ [: `' ' | '\t' | '\n' | '\r'; s :] -> lexer kwt s
-  | [: `';'; a = semi kwt bp :] -> a
-  | [: `'(' :] -> (("", "("), (bp, bp + 1))
-  | [: `')' :] -> (("", ")"), (bp, bp + 1))
-  | [: `'"'; s = string 0 :] ep -> (("STRING", s), (bp, ep))
-  | [: `'''; tok = quote :] ep -> (tok, (bp, ep))
-  | [: `'<'; tok = less :] ep -> (tok, (bp, ep))
-  | [: `('0'..'9' as c); n = number (Buff.store 0 c) :] ep -> (n, (bp, ep))
+  [ [: `' ' | '\t' | '\n' | '\r'; s :] -> lexer kwt fname lnum bolpos s
+  | [: `';'; a = semi kwt mkloc fname lnum bolpos bp :] -> a
+  | [: `'(' :] -> (("", "("), mkloc(bp, bp + 1))
+  | [: `')' :] -> (("", ")"), mkloc(bp, bp + 1))
+  | [: `'"'; s = string 0 :] ep -> (("STRING", s), mkloc(bp, ep))
+  | [: `'''; tok = quote :] ep -> (tok, mkloc(bp, ep))
+  | [: `'<'; tok = less :] ep -> (tok, mkloc(bp, ep))
+  | [: `('0'..'9' as c); n = number (Buff.store 0 c) :] ep -> (n, mkloc(bp, ep))
   | [: `x; s = ident (Buff.store 0 x) :] ep ->
       let con =
         try do { (Hashtbl.find kwt s : unit); "" } with
@@ -94,12 +98,12 @@ value rec lexer kwt =
             [ 'A'..'Z' -> "UIDENT"
             | _ -> "LIDENT" ] ]
       in
-      ((con, s), (bp, ep))
-  | [: :] -> (("EOI", ""), (bp, bp + 1)) ]
-and semi kwt bp =
+      ((con, s), mkloc(bp, ep))
+  | [: :] -> (("EOI", ""), mkloc(bp, bp + 1)) ]
+and semi kwt mkloc fname lnum bolpos bp =
   parser
-  [ [: `';'; _ = skip_to_eol; s :] -> lexer kwt s
-  | [: :] ep -> (("", ";"), (bp, ep)) ]
+  [ [: `';'; _ = skip_to_eol; s :] -> lexer kwt fname lnum bolpos s
+  | [: :] ep -> (("", ";"), mkloc(bp, ep)) ]
 and less =
   parser
   [ [: `':'; lab = label 0; `'<' ? "'<' expected"; q = quotation 0 :] ->
@@ -139,8 +143,11 @@ value lexer_text (con, prm) =
 ;
 
 value lexer_gmake () =
+  let bolpos = ref 0 in
+  let lnum = ref 0 in
+  let fname = ref "" in
   let kwt = Hashtbl.create 89 in
-  {Token.tok_func = Token.lexer_func_of_parser (lexer kwt);
+  {Token.tok_func = Token.lexer_func_of_parser (lexer kwt fname lnum bolpos);
    Token.tok_using = lexer_using kwt; Token.tok_removing = fun [];
    Token.tok_match = Token.default_match; Token.tok_text = lexer_text;
    Token.tok_comm = None}
@@ -378,7 +385,8 @@ and expr_ident_se loc s =
       if i = String.length s then
         if i > ibeg then expr_id loc (String.sub s ibeg (i - ibeg))
         else
-          raise_with_loc (fst loc + i - 1, fst loc + i)
+          raise_with_loc
+            (Reloc.shift_pos "pa_lisp:expr_ident_se1" (i-1) (fst loc), Reloc.shift_pos "pa_lisp:expr_ident_se2"  i (fst loc))
             (Stream.Error "expr expected")
       else if s.[i] = '.' then
         if i > ibeg then
@@ -386,7 +394,8 @@ and expr_ident_se loc s =
           let e2 = loop (i + 1) (i + 1) in
           <:expr< $e1$ . $e2$ >>
         else
-          raise_with_loc (fst loc + i - 1, fst loc + i + 1)
+          raise_with_loc
+            (Reloc.shift_pos "pa_lisp:expr_ident_se3" (i-1) (fst loc), Reloc.shift_pos "pa_lisp:expr_ident_se4" (i+1) (fst loc))
             (Stream.Error "expr expected")
       else loop ibeg (i + 1)
     in
@@ -493,7 +502,8 @@ and patt_ident_se loc s =
     if i = String.length s then
       if i > ibeg then patt_id loc (String.sub s ibeg (i - ibeg))
       else
-        raise_with_loc (fst loc + i - 1, fst loc + i)
+        raise_with_loc
+          (Reloc.shift_pos "" (i-1) (fst loc), Reloc.shift_pos "" i (fst loc))
           (Stream.Error "patt expected")
     else if s.[i] = '.' then
       if i > ibeg then
@@ -501,7 +511,8 @@ and patt_ident_se loc s =
         let p2 = loop (i + 1) (i + 1) in
         <:patt< $p1$ . $p2$ >>
       else
-        raise_with_loc (fst loc + i - 1, fst loc + i + 1)
+        raise_with_loc
+          (Reloc.shift_pos "" (i-1) (fst loc), Reloc.shift_pos "" (i+1) (fst loc))
           (Stream.Error "patt expected")
     else loop ibeg (i + 1)
 and ipatt_se se =
@@ -554,7 +565,8 @@ and ctyp_ident_se loc s =
     if i = String.length s then
       if i > ibeg then ctyp_id loc (String.sub s ibeg (i - ibeg))
       else
-        raise_with_loc (fst loc + i - 1, fst loc + i)
+        raise_with_loc
+          (Reloc.shift_pos "" (i-1) (fst loc), Reloc.shift_pos "" i (fst loc))
           (Stream.Error "ctyp expected")
     else if s.[i] = '.' then
       if i > ibeg then
@@ -562,7 +574,8 @@ and ctyp_ident_se loc s =
         let t2 = loop (i + 1) (i + 1) in
         <:ctyp< $t1$ . $t2$ >>
       else
-        raise_with_loc (fst loc + i - 1, fst loc + i + 1)
+        raise_with_loc
+          (Reloc.shift_pos "" (i-1) (fst loc), Reloc.shift_pos "" (i+1) (fst loc))
           (Stream.Error "ctyp expected")
     else loop ibeg (i + 1)
 and constructor_declaration_se =
@@ -617,6 +630,7 @@ Pcaml.parse_implem.val := Grammar.Entry.parse implem;
 value sexpr = Grammar.Entry.create gram "sexpr";
 value atom = Grammar.Entry.create gram "atom";
 
+
 EXTEND
   implem:
     [ [ st = LIST0 [ s = str_item -> (s, loc) ]; EOI -> (st, False) ] ]
diff --git a/camlp4/etc/pa_o.ml b/camlp4/etc/pa_o.ml
index 4f27f5ecc6..be34d6cd25 100644
--- a/camlp4/etc/pa_o.ml
+++ b/camlp4/etc/pa_o.ml
@@ -70,6 +70,7 @@ value mkumin loc f arg =
       <:expr< $lid:f$ $arg$ >> ]
 ;
 
+
 value mklistexp loc last =
   loop True where rec loop top =
     fun
@@ -407,6 +408,7 @@ and sync_semisemi cs =
 Pcaml.sync.val := sync;
 *)
 
+
 EXTEND
   GLOBAL: sig_item str_item ctyp patt expr module_type module_expr class_type
     class_expr class_sig_item class_str_item let_binding type_declaration;
@@ -422,11 +424,13 @@ EXTEND
           <:module_expr< ( $me$ : $mt$ ) >>
       | "("; me = SELF; ")" -> <:module_expr< $me$ >> ] ]
   ;
+
   mod_expr_ident:
     [ LEFTA
       [ i = SELF; "."; j = SELF -> <:module_expr< $i$ . $j$ >> ]
     | [ i = UIDENT -> <:module_expr< $uid:i$ >> ] ]
   ;
+
   str_item:
     [ "top"
       [ "exception"; (_, c, tl) = constructor_declaration; b = rebind_exn ->
@@ -458,6 +462,7 @@ EXTEND
           <:str_item< let module $m$ = $mb$ in $e$ >>
       | e = expr -> <:str_item< $exp:e$ >> ] ]
   ;
+
   rebind_exn:
     [ [ "="; sl = mod_ident -> sl
       | -> [] ] ]
@@ -564,7 +569,10 @@ EXTEND
         "do"; e = SELF; "done" ->
           <:expr< for $i$ = $e1$ $to:df$ $e2$ do { $list:get_seq e$ } >>
       | "while"; e1 = SELF; "do"; e2 = SELF; "done" ->
-          <:expr< while $e1$ do { $list:get_seq e2$ } >> ]
+          <:expr< while $e1$ do { $list:get_seq e2$ } >>
+      | "object"; cspo = OPT class_self_patt; cf = class_structure; "end" ->
+          (* <:expr< object $opt:cspo$ $list:cf$ end >> *)
+          MLast.ExObj loc cspo cf ]
     | [ e = SELF; ","; el = LIST1 NEXT SEP "," ->
           <:expr< ( $list:[e :: el]$ ) >> ]
     | ":=" NONA
@@ -675,10 +683,13 @@ EXTEND
           let x =
             try
               let i = String.index x ':' in
-              (int_of_string (String.sub x 0 i),
+              ({Lexing.pos_fname = "";
+                Lexing.pos_lnum = 0;
+                Lexing.pos_bol = 0;
+                Lexing.pos_cnum = int_of_string (String.sub x 0 i)},
                String.sub x (i + 1) (String.length x - i - 1))
             with
-            [ Not_found | Failure _ -> (0, x) ]
+            [ Not_found | Failure _ -> (Token.nowhere, x) ]
           in
           Pcaml.handle_expr_locate loc x
       | x = QUOTATION ->
@@ -810,10 +821,13 @@ EXTEND
           let x =
             try
               let i = String.index x ':' in
-              (int_of_string (String.sub x 0 i),
+              ({Lexing.pos_fname = "";
+                Lexing.pos_lnum = 0;
+                Lexing.pos_bol = 0;
+                Lexing.pos_cnum = int_of_string (String.sub x 0 i)},
                String.sub x (i + 1) (String.length x - i - 1))
             with
-            [ Not_found | Failure _ -> (0, x) ]
+            [ Not_found | Failure _ -> (Token.nowhere, x) ]
           in
           Pcaml.handle_patt_locate loc x
       | x = QUOTATION ->
diff --git a/camlp4/etc/pa_ocamllex.ml b/camlp4/etc/pa_ocamllex.ml
index d567c2ad73..ed550ac9ae 100644
--- a/camlp4/etc/pa_ocamllex.ml
+++ b/camlp4/etc/pa_ocamllex.ml
@@ -19,7 +19,7 @@ let output_byte buf b =
   Buffer.add_char buf (Char.chr(48 + (b / 10) mod 10));
   Buffer.add_char buf (Char.chr(48 + b mod 10))
 
-let loc = (-1,-1)
+let loc = (Lexing.dummy_pos,Lexing.dummy_pos)
 
 let output_array v =
   let b = Buffer.create (Array.length v * 3) in
@@ -256,7 +256,7 @@ EXTEND
  ];
  
  definition: [
-   [ x=LIDENT; pl = LIST0 Pcaml.patt; "=";  
+   [ x=LIDENT; pl = LIST0 Pcaml.patt LEVEL "simple"; "=";
      short=[ LIDENT "parse" -> false | LIDENT "shortest" -> true ];
      OPT "|"; l = LIST0 [ r=regexp; a=action -> (r,a) ] SEP "|" ->
      { name=x ; shortest=short ; args=pl ; clauses = l } ]
diff --git a/camlp4/etc/pa_olabl.ml b/camlp4/etc/pa_olabl.ml
index d43b499dfd..77322f8432 100644
--- a/camlp4/etc/pa_olabl.ml
+++ b/camlp4/etc/pa_olabl.ml
@@ -186,13 +186,18 @@ module Plexer =
       | [: :] -> () ]
     ;
     value error_on_unknown_keywords = ref False;
-    value next_token_fun find_id_kwd find_spe_kwd =
-      let err bp ep msg = raise_with_loc (bp, ep) (Token.Error msg) in
-      let keyword_or_error (bp, ep) s =
+    value next_token_fun find_id_kwd find_spe_kwd fname lnum bolpos =
+      let make_pos p =
+        {Lexing.pos_fname = fname.val; Lexing.pos_lnum = lnum.val;
+         Lexing.pos_bol = bolpos.val; Lexing.pos_cnum = p} in
+      let mkloc (bp, ep) = (make_pos bp, make_pos ep) in
+
+      let err loc msg = raise_with_loc loc (Token.Error msg) in
+      let keyword_or_error (bp,ep) s =
         try ("", find_spe_kwd s) with
         [ Not_found ->
             if error_on_unknown_keywords.val then
-              err bp ep ("illegal token: " ^ s)
+              err (mkloc (bp, ep)) ("illegal token: " ^ s)
             else ("", s) ]
       in
       let rec next_token =
@@ -280,14 +285,14 @@ module Plexer =
         [ [: `'"' :] -> get_buff len
         | [: `'\\'; `c; s :] -> string bp (store (store len '\\') c) s
         | [: `c; s :] -> string bp (store len c) s
-        | [: :] ep -> err bp ep "string not terminated" ]
+        | [: :] ep -> err (mkloc (bp, ep)) "string not terminated" ]
       and char bp len =
         parser
         [ [: `'''; s :] ->
             if len = 0 then char bp (store len ''') s else get_buff len
         | [: `'\\'; `c; s :] -> char bp (store (store len '\\') c) s
         | [: `c; s :] -> char bp (store len c) s
-        | [: :] ep -> err bp ep "char not terminated" ]
+        | [: :] ep -> err (mkloc(bp,ep)) "char not terminated" ]
       and locate_or_antiquot bp len =
         parser
         [ [: `'$' :] -> ("ANTIQUOT", ":" ^ get_buff len)
@@ -300,7 +305,7 @@ module Plexer =
             ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s)
         | [: `c; s :] ->
             ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s)
-        | [: :] ep -> err bp ep "antiquotation not terminated" ]
+        | [: :] ep -> err (mkloc(bp,ep)) "antiquotation not terminated" ]
       and maybe_locate bp len =
         parser
         [ [: `'$' :] -> ("ANTIQUOT", ":" ^ get_buff len)
@@ -311,7 +316,7 @@ module Plexer =
             ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s)
         | [: `c; s :] ->
             ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s)
-        | [: :] ep -> err bp ep "antiquotation not terminated" ]
+        | [: :] ep -> err (mkloc(bp,ep)) "antiquotation not terminated" ]
       and antiquot bp len =
         parser
         [ [: `'$' :] -> ("ANTIQUOT", ":" ^ get_buff len)
@@ -324,13 +329,13 @@ module Plexer =
             ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s)
         | [: `c; s :] ->
             ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s)
-        | [: :] ep -> err bp ep "antiquotation not terminated" ]
+        | [: :] ep -> err (mkloc(bp,ep)) "antiquotation not terminated" ]
       and locate_or_antiquot_rest bp len =
         parser
         [ [: `'$' :] -> get_buff len
         | [: `'\\'; `c; s :] -> locate_or_antiquot_rest bp (store len c) s
         | [: `c; s :] -> locate_or_antiquot_rest bp (store len c) s
-        | [: :] ep -> err bp ep "antiquotation not terminated" ]
+        | [: :] ep -> err (mkloc(bp,ep)) "antiquotation not terminated" ]
       and quotation bp len =
         parser
         [ [: `'>'; s :] -> maybe_end_quotation bp len s
@@ -344,7 +349,7 @@ module Plexer =
              s :] ->
             quotation bp len s
         | [: `c; s :] -> quotation bp (store len c) s
-        | [: :] ep -> err bp ep "quotation not terminated" ]
+        | [: :] ep -> err (mkloc(bp,ep)) "quotation not terminated" ]
       and maybe_nested_quotation bp len =
         parser
         [ [: `'<'; s :] -> mstore (quotation bp (store len '<') s) ">>"
@@ -366,20 +371,20 @@ module Plexer =
             next_token_loc s
         | [: `'('; s :] -> maybe_comment bp s
         | [: `'#'; _ = spaces_tabs; a = linenum bp :] -> a
-        | [: tok = next_token :] ep -> (tok, (bp, ep))
-        | [: _ = Stream.empty :] -> (("EOI", ""), (bp, succ bp)) ]
+        | [: tok = next_token :] ep -> (tok, mkloc(bp, ep))
+        | [: _ = Stream.empty :] -> (("EOI", ""), mkloc(bp, succ bp)) ]
       and maybe_comment bp =
         parser
         [ [: `'*'; s :] -> do { comment bp s; next_token_loc s }
         | [: :] ep ->
             let tok = keyword_or_error (bp, ep) "(" in
-            (tok, (bp, ep)) ]
+            (tok, mkloc(bp, ep)) ]
       and comment bp =
         parser
         [ [: `'('; s :] -> maybe_nested_comment bp s
         | [: `'*'; s :] -> maybe_end_comment bp s
         | [: `c; s :] -> comment bp s
-        | [: :] ep -> err bp ep "comment not terminated" ]
+        | [: :] ep -> err (mkloc(bp,ep)) "comment not terminated" ]
       and maybe_nested_comment bp =
         parser
         [ [: `'*'; s :] -> do { comment bp s; comment bp s }
@@ -391,7 +396,7 @@ module Plexer =
         [ [: `'0'..'9'; _ = digits; _ = spaces_tabs; `'"'; _ = any_to_nl;
              s :] ->
             next_token_loc s
-        | [: :] -> (keyword_or_error (bp, bp + 1) "#", (bp, bp + 1)) ]
+        | [: :] -> (keyword_or_error (bp, bp + 1) "#", mkloc(bp, bp + 1)) ]
       and spaces_tabs =
         parser [ [: `' ' | '\t'; s :] -> spaces_tabs s | [: :] -> () ]
       and digits = parser [ [: `'0'..'9'; s :] -> digits s | [: :] -> () ]
@@ -404,7 +409,7 @@ module Plexer =
       fun cstrm ->
         try next_token_loc cstrm with
         [ Stream.Error str ->
-            err (Stream.count cstrm) (Stream.count cstrm + 1) str ]
+            err (mkloc(Stream.count cstrm, Stream.count cstrm + 1)) str ]
     ;
     value locerr () = invalid_arg "Lexer: location function";
     value loct_create () = ref (Array.create 1024 None);
@@ -429,9 +434,12 @@ module Plexer =
       }
     ;
     value func kwd_table =
+      let bolpos = ref 0 in
+      let lnum = ref 0 in
+      let fname = ref "" in
       let find = Hashtbl.find kwd_table in
       let lex cstrm =
-        let next_token_loc = next_token_fun find find in
+        let next_token_loc = next_token_fun find find fname lnum bolpos in
         let loct = loct_create () in
         let ts =
           Stream.from
@@ -620,7 +628,7 @@ value mkumin loc f arg =
       <:expr< $lid:f$ $arg$ >> ]
 ;
 
-external loc_of_node : 'a -> (int * int) = "%field0";
+external loc_of_node : 'a -> MLast.loc = "%field0";
 
 value mklistexp loc last =
   loop True where rec loop top =
@@ -1139,10 +1147,13 @@ EXTEND
           let x =
             try
               let i = String.index x ':' in
-              (int_of_string (String.sub x 0 i),
+              ({Lexing.pos_fname = "";
+                Lexing.pos_lnum = 0;
+                Lexing.pos_bol = 0;
+                Lexing.pos_cnum = int_of_string (String.sub x 0 i)},
                String.sub x (i + 1) (String.length x - i - 1))
             with
-            [ Not_found | Failure _ -> (0, x) ]
+            [ Not_found | Failure _ -> (Token.nowhere, x) ]
           in
           Pcaml.handle_expr_locate loc x
       | x = QUOTATION ->
@@ -1265,10 +1276,13 @@ EXTEND
           let x =
             try
               let i = String.index x ':' in
-              (int_of_string (String.sub x 0 i),
+              ({Lexing.pos_fname = "";
+                Lexing.pos_lnum = 0;
+                Lexing.pos_bol = 0;
+                Lexing.pos_cnum =  int_of_string (String.sub x 0 i)},
                String.sub x (i + 1) (String.length x - i - 1))
             with
-            [ Not_found | Failure _ -> (0, x) ]
+            [ Not_found | Failure _ -> (Token.nowhere, x) ]
           in
           Pcaml.handle_patt_locate loc x
       | x = QUOTATION ->
diff --git a/camlp4/etc/pa_oop.ml b/camlp4/etc/pa_oop.ml
index fd56158346..1316bda1b2 100644
--- a/camlp4/etc/pa_oop.ml
+++ b/camlp4/etc/pa_oop.ml
@@ -109,6 +109,7 @@ value rec cstream gloc =
 
 (* Syntax extensions in Ocaml grammar *)
 
+
 EXTEND
   GLOBAL: expr;
   expr: LEVEL "expr1"
diff --git a/camlp4/etc/pa_schemer.ml b/camlp4/etc/pa_schemer.ml
index a7d64ce4a5..ff2f9447ce 100644
--- a/camlp4/etc/pa_schemer.ml
+++ b/camlp4/etc/pa_schemer.ml
@@ -111,7 +111,7 @@ value digits kind bp len =
   parser
   [ [: d = kind; s :] -> ("INT", digits_under kind (Buff.store len d) s)
   | [: s :] ep ->
-      raise_with_loc (bp, ep) (Failure "ill-formed integer constant") ]
+      raise_with_loc (Reloc.shift_pos "" bp Token.nowhere, Reloc.shift_pos "" ep Token.nowhere) (Failure "ill-formed integer constant") ]
 ;
 
 value base_number kwt bp len =
@@ -133,7 +133,7 @@ value char_or_quote_id x =
   [ [: `''' :] -> ("CHAR", String.make 1 x)
   | [: s :] ep ->
       if List.mem x no_ident then
-        Stdpp.raise_with_loc (ep - 2, ep - 1) (Stream.Error "bad quote")
+        Stdpp.raise_with_loc (Reloc.shift_pos "" (ep - 2) Token.nowhere, Reloc.shift_pos "" (ep - 1) Token.nowhere) (Stream.Error "bad quote")
       else
         let len = Buff.store (Buff.store 0 ''') x in
         let (s, dot) = ident len s in
@@ -168,7 +168,7 @@ value rec lexer kwt = parser [: t = lexer0 kwt; _ = no_dot :] -> t
 and no_dot =
   parser
   [ [: `'.' :] ep ->
-      Stdpp.raise_with_loc (ep - 1, ep) (Stream.Error "bad dot")
+      Stdpp.raise_with_loc (Reloc.shift_pos "" (ep - 1) Token.nowhere, Reloc.shift_pos "" ep Token.nowhere) (Stream.Error "bad dot")
   | [: :] -> () ]
 and lexer0 kwt =
   parser bp
@@ -262,7 +262,10 @@ value lexer_text (con, prm) =
 
 value lexer_gmake () =
   let kwt = Hashtbl.create 89 in
-  {Token.tok_func = Token.lexer_func_of_parser (lexer kwt);
+  {Token.tok_func =
+     Token.lexer_func_of_parser
+       (fun s -> let (r,(bp,ep)) = lexer kwt s in
+                   (r, (Reloc.shift_pos "" bp Token.nowhere, Reloc.shift_pos "" ep Token.nowhere)));
    Token.tok_using = lexer_using kwt; Token.tok_removing = fun [];
    Token.tok_match = Token.default_match; Token.tok_text = lexer_text;
    Token.tok_comm = None}
diff --git a/camlp4/etc/pa_sml.ml b/camlp4/etc/pa_sml.ml
index ee5db540d1..719b52a4bd 100644
--- a/camlp4/etc/pa_sml.ml
+++ b/camlp4/etc/pa_sml.ml
@@ -912,7 +912,9 @@ EXTEND
             else
               match x4 with
               [ <:module_expr< struct $list:list$ end >> ->
-                  let si = let loc = (0, 0) in <:str_item< open AAA >> in
+                  let si =
+                    let loc = (Token.nowhere, Token.nowhere) in
+                    <:str_item< open AAA >> in
                   <:module_expr< struct $list:[si :: list]$ end >>
               | _ -> not_impl loc "fctb 1" ]
           in
diff --git a/camlp4/etc/parserify.ml b/camlp4/etc/parserify.ml
index c8ce441714..04040858d3 100644
--- a/camlp4/etc/parserify.ml
+++ b/camlp4/etc/parserify.ml
@@ -1,7 +1,7 @@
 (* camlp4r q_MLast.cmo *)
 (* $Id$ *)
 
-value loc = (0, 0);
+value loc = (Token.nowhere, Token.nowhere);
 
 type spc =
   [ SPCterm of (MLast.patt * option MLast.expr)
diff --git a/camlp4/etc/pr_extend.ml b/camlp4/etc/pr_extend.ml
index 43e3794e17..7a658ed278 100644
--- a/camlp4/etc/pr_extend.ml
+++ b/camlp4/etc/pr_extend.ml
@@ -99,7 +99,7 @@ value unassoc =
 
 value rec unaction =
   fun
-  [ <:expr< fun ($lid:locp$ : (int * int)) -> ($a$ : $_$) >>
+  [ <:expr< fun ($lid:locp$ : (Lexing.position * Lexing.position)) -> ($a$ : $_$) >>
     when locp = Stdpp.loc_name.val ->
       let ao =
         match a with
@@ -111,7 +111,7 @@ value rec unaction =
       let (pl, a) = unaction e in ([p :: pl], a)
   | <:expr< fun _ -> $e$ >> ->
       let (pl, a) = unaction e in
-      (let loc = (0, 0) in [<:patt< _ >> :: pl], a)
+      (let loc = (Token.nowhere, Token.nowhere) in [<:patt< _ >> :: pl], a)
   | _ -> raise Not_found ]
 ;
 
@@ -174,7 +174,7 @@ and unrule =
   [ <:expr< ($e1$, Gramext.action $e2$) >> ->
       let (pl, a) =
         match unaction e2 with
-        [ ([], None) -> let loc = (0, 0) in ([], Some <:expr< () >>)
+        [ ([], None) -> let loc = (Token.nowhere, Token.nowhere) in ([], Some <:expr< () >>)
         | x -> x ]
       in
       let sl = unpsymbol_list (List.rev pl) e1 in
@@ -389,6 +389,8 @@ value label =
   | None -> [: :] ]
 ;
 
+value intloc loc = ((fst loc).Lexing.pos_cnum, (snd loc).Lexing.pos_cnum);
+
 value assoc =
   fun
   [ Some Gramext.NonA -> [: `S LR "NONA" :]
@@ -419,7 +421,7 @@ value level_list ll k =
 
 value entry (e, pos, ll) k =
   BEbox
-    [: `LocInfo (MLast.loc_of_expr e)
+    [: `LocInfo (intloc(MLast.loc_of_expr e))
           (HVbox [: `expr e "" [: `S RO ":" :]; position pos :]);
        `level_list  ll [: :];
        `HVbox [: `S RO ";"; k :] :]
diff --git a/camlp4/etc/pr_extfun.ml b/camlp4/etc/pr_extfun.ml
index 4d5c036615..b12527eb39 100644
--- a/camlp4/etc/pr_extfun.ml
+++ b/camlp4/etc/pr_extfun.ml
@@ -4,7 +4,7 @@
 open Pcaml;
 open Spretty;
 
-value loc = (0, 0);
+value loc = (Token.nowhere, Token.nowhere);
 
 value expr e dg k = pr_expr.pr_fun "top" e dg k;
 value patt e dg k = pr_patt.pr_fun "top" e dg k;
diff --git a/camlp4/etc/pr_o.ml b/camlp4/etc/pr_o.ml
index d87566726a..bf15c54283 100644
--- a/camlp4/etc/pr_o.ml
+++ b/camlp4/etc/pr_o.ml
@@ -143,7 +143,7 @@ value conv_lab =
 
 (* default global loc *)
 
-value loc = (0, 0);
+value loc = (Token.nowhere, Token.nowhere);
 
 value id_var s =
   if has_special_chars s || is_infix s then
@@ -204,17 +204,19 @@ value private_flag =
   | _ -> [: :] ]
 ;
 
+value intloc loc = ((fst loc).Lexing.pos_cnum, (snd loc).Lexing.pos_cnum);
+
 value rec labels loc b vl _ k =
   match vl with
   [ [] -> [: b; k :]
   | [v] ->
-      [: `label True b v "" k; `LocInfo (snd loc, snd loc) (HVbox [: :]) :]
+      [: `label True b v "" k; `LocInfo (intloc(snd loc, snd loc)) (HVbox [: :]) :]
   | [v :: l] -> [: `label False b v "" [: :]; labels loc [: :] l "" k :] ]
 and label is_last b (loc, f, m, t) _ k =
   let m = flag "mutable" m in
   let k = [: if is_last then [: :] else [: `S RO ";" :]; k :] in
   Hbox
-    [: `LocInfo loc
+    [: `LocInfo (intloc loc)
           (HVbox
              [: `HVbox [: b; m; `S LR (conv_lab f); `S LR ":" :];
                 `ctyp t "" [: :] :]);
@@ -226,15 +228,15 @@ value rec ctyp_list tel _ k = listws simple_ctyp (S LR "*") tel "" k;
 value rec variants loc b vl dg k =
   match vl with
   [ [] -> [: b; k :]
-  | [v] -> [: `variant b v "" k; `LocInfo (snd loc, snd loc) (HVbox [: :]) :]
+  | [v] -> [: `variant b v "" k; `LocInfo (intloc(snd loc, snd loc)) (HVbox [: :]) :]
   | [v :: l] ->
       [: `variant b v "" [: :]; variants loc [: `S LR "|" :] l "" k :] ]
 and variant b (loc, c, tl) _ k =
   match tl with
-  [ [] -> HVbox [: `LocInfo loc (HVbox b); `HOVbox [: `S LR c; k :] :]
+  [ [] -> HVbox [: `LocInfo (intloc loc) (HVbox b); `HOVbox [: `S LR c; k :] :]
   | _ ->
       HVbox
-        [: `LocInfo loc (HVbox b);
+        [: `LocInfo (intloc loc) (HVbox b);
            `HOVbox [: `S LR c; `S LR "of"; ctyp_list tl "" k :] :] ]
 ;
 
@@ -342,7 +344,7 @@ value raise_match_failure (bp, ep) k =
     if Pcaml.input_file.val <> "-" then
       Stdpp.line_of_loc Pcaml.input_file.val (bp, ep)
     else
-      ("-", 1, bp, ep)
+      ("-", bp.Lexing.pos_lnum, bp.Lexing.pos_cnum - bp.Lexing.pos_bol,  ep.Lexing.pos_cnum - ep.Lexing.pos_bol)
   in
   HOVbox
     [: `S LR "raise"; `S LO "("; `S LR "Match_failure"; `S LO "(";
@@ -362,7 +364,7 @@ and let_binding b (p, e) _ k =
     let (bp2, ep2) = MLast.loc_of_expr e in
     (min bp1 bp2, max ep1 ep2)
   in
-  LocInfo loc (BEbox (let_binding0 b p e k))
+  LocInfo (intloc loc) (BEbox (let_binding0 b p e k))
 and let_binding0 b p e k =
   let (pl, e) =
     match p with
@@ -387,7 +389,7 @@ and match_assoc_list loc pel dg k =
         [: `HVbox [: `S LR "_"; `S LR "->" :]; `raise_match_failure loc k :]
   | _ ->
       BEVbox
-        [: `HVbox [: :]; listwbws match_assoc [: :] (S LR "|") pel "" k :] ]
+        [: `HVbox [: :]; listwbws match_assoc [: :] (S LR "|") pel dg k :] ]
 and match_assoc b (p, w, e) dg k =
   let s =
     match w with
@@ -606,7 +608,7 @@ and class_signature cs k =
       class_self_type [: `S LR "object" :] cst
         [: `HVbox
               [: `HVbox [: :]; list class_sig_item csf "" [: :];
-                 `LocInfo (ep, ep) (HVbox [: :]) :];
+                 `LocInfo (intloc(ep, ep)) (HVbox [: :]) :];
            `HVbox [: `S LR "end"; k :] :]
   | _ -> HVbox [: `not_impl "class_signature" cs; k :] ]
 and class_self_type b cst k =
@@ -664,7 +666,7 @@ pr_module_type.pr_levels :=
                   [: `S LR "sig";
                      `HVbox
                         [: `HVbox [: :]; list sig_item s "" [: :];
-                           `LocInfo (ep, ep) (HVbox [: :]) :];
+                           `LocInfo (intloc(ep, ep)) (HVbox [: :]) :];
                      `HVbox [: `S LR "end"; k :] :] :]
       | e -> fun curr next dg k -> [: `next e dg k :] ]};
    {pr_label = ""; pr_box mt x = HVbox x;
@@ -697,7 +699,7 @@ pr_module_expr.pr_levels :=
             [: `HVbox [: :];
                `HVbox
                   [: `S LR "struct"; list str_item s "" [: :];
-                     `LocInfo (ep, ep) (HVbox [: :]) :];
+                     `LocInfo (intloc(ep, ep)) (HVbox [: :]) :];
                `HVbox [: `S LR "end"; k :] :]
       | <:module_expr< functor ($s$ : $mt$) -> $me$ >> ->
           fun curr next dg k ->
@@ -740,7 +742,7 @@ pr_module_expr.pr_levels :=
 
 pr_sig_item.pr_levels :=
   [{pr_label = "top";
-    pr_box s x = LocInfo (MLast.loc_of_sig_item s) (HVbox x);
+    pr_box s x = LocInfo (intloc(MLast.loc_of_sig_item s)) (HVbox x);
     pr_rules =
       extfun Extfun.empty with
       [ <:sig_item< type $list:stl$ >> ->
@@ -788,7 +790,7 @@ pr_sig_item.pr_levels :=
 
 pr_str_item.pr_levels :=
   [{pr_label = "top";
-    pr_box s x = LocInfo (MLast.loc_of_str_item s) (HVbox x);
+    pr_box s x = LocInfo (intloc(MLast.loc_of_str_item s)) (HVbox x);
     pr_rules =
       extfun Extfun.empty with
       [ <:str_item< open $i$ >> ->
@@ -871,14 +873,14 @@ value ocaml_char =
 ;
 
 pr_expr.pr_levels :=
-  [{pr_label = "top"; pr_box e x = LocInfo (MLast.loc_of_expr e) (HOVbox x);
+  [{pr_label = "top"; pr_box e x = LocInfo (intloc(MLast.loc_of_expr e)) (HOVbox x);
     pr_rules =
       extfun Extfun.empty with
       [ <:expr< do { $list:el$ } >> ->
           fun curr next dg k ->
             [: `HVbox [: `HVbox [: :]; listws next (S RO ";") el dg k :] :]
       | e -> fun curr next dg k -> [: `next e dg k :] ]};
-   {pr_label = "expr1"; pr_box e x = LocInfo (MLast.loc_of_expr e) (HOVbox x);
+   {pr_label = "expr1"; pr_box e x = LocInfo (intloc(MLast.loc_of_expr e)) (HOVbox x);
     pr_rules =
       extfun Extfun.empty with
       [ <:expr< let $opt:r$ $p1$ = $e1$ in $e$ >> ->
@@ -955,11 +957,11 @@ pr_expr.pr_levels :=
                               [: `S LR "fun";
                                  list simple_patt [p :: pl] ""
                                    [: `S LR "->" :] :];
-                           `expr e "" k :] :]
+                           `expr e dg k :] :]
               | _ ->
                   [: `Vbox
                         [: `HVbox [: :]; `S LR "function";
-                           `match_assoc_list loc pel "" k :] :] ]
+                           `match_assoc_list loc pel dg k :] :] ]
             else
               match pel with
               [ [] ->
@@ -1079,7 +1081,7 @@ pr_expr.pr_levels :=
                            `HVbox [: `S LR "else"; `expr1 e dg k :] :] :] ]
             else
               match eel_e with
-              [ (_, <:expr< () >>) -> [: `next e "" k :]
+              [ (_, <:expr< () >>) -> [: `simple_expr e "" k :]
               | (eel, e) ->
                   [: `HVbox
                         [: `HVbox [: :];
@@ -1309,7 +1311,7 @@ pr_expr.pr_levels :=
             | Some x -> [: `next e "" k :] ]
       | e -> fun curr next dg k -> [: `next e dg k :] ]};
    {pr_label = "simple";
-    pr_box e x = LocInfo (MLast.loc_of_expr e) (HOVbox x);
+    pr_box e x = LocInfo (intloc(MLast.loc_of_expr e)) (HOVbox x);
     pr_rules =
       extfun Extfun.empty with
       [ ( <:expr< $int:x$ >> | <:expr< $flo:x$ >> )
@@ -1412,7 +1414,7 @@ pr_expr.pr_levels :=
       | e -> fun curr next _ k -> [: `not_impl "expr" e :] ]}];
 
 pr_patt.pr_levels :=
-  [{pr_label = "top"; pr_box p x = LocInfo (MLast.loc_of_patt p) (HOVCbox x);
+  [{pr_label = "top"; pr_box p x = LocInfo (intloc(MLast.loc_of_patt p)) (HOVCbox x);
     pr_rules =
       extfun Extfun.empty with
       [ <:patt< ($x$ as $lid:y$) >> ->
@@ -1480,7 +1482,7 @@ pr_patt.pr_levels :=
             | _ -> [: curr x "" [: :]; `next y "" k :] ]
       | p -> fun curr next dg k -> [: `next p "" k :] ]};
    {pr_label = "simple";
-    pr_box p x = LocInfo (MLast.loc_of_patt p) (HOVbox x);
+    pr_box p x = LocInfo (intloc(MLast.loc_of_patt p)) (HOVbox x);
     pr_rules =
       extfun Extfun.empty with
       [ <:patt< $x$ . $y$ >> ->
@@ -1574,7 +1576,7 @@ pr_patt.pr_levels :=
       | p -> fun curr next dg k -> [: `next p "" k :] ]}];
 
 pr_ctyp.pr_levels :=
-  [{pr_label = "top"; pr_box t x = LocInfo (MLast.loc_of_ctyp t) (HOVbox x);
+  [{pr_label = "top"; pr_box t x = LocInfo (intloc(MLast.loc_of_ctyp t)) (HOVbox x);
     pr_rules =
       extfun Extfun.empty with
       [ <:ctyp< $x$ as $y$ >> ->
@@ -1600,7 +1602,7 @@ pr_ctyp.pr_levels :=
           fun curr next dg k -> listws next (S LR "*") tl "" k
       | t -> fun curr next dg k -> [: `next t "" k :] ]};
    {pr_label = "simple";
-    pr_box t x = LocInfo (MLast.loc_of_ctyp t) (HOVbox x);
+    pr_box t x = LocInfo (intloc(MLast.loc_of_ctyp t)) (HOVbox x);
     pr_rules =
       extfun Extfun.empty with
       [ <:ctyp< $t1$ == $t2$ >> ->
@@ -1718,7 +1720,7 @@ pr_ctyp.pr_levels :=
 
 pr_class_str_item.pr_levels :=
   [{pr_label = "top";
-    pr_box s x = LocInfo (MLast.loc_of_class_str_item s) (HVbox x);
+    pr_box s x = LocInfo (intloc(MLast.loc_of_class_str_item s)) (HVbox x);
     pr_rules =
       extfun Extfun.empty with
       [ MLast.CrDcl _ s ->
@@ -1756,7 +1758,7 @@ pr_class_str_item.pr_levels :=
 
 pr_class_sig_item.pr_levels :=
   [{pr_label = "top";
-    pr_box s x = LocInfo (MLast.loc_of_class_sig_item s) (HVbox x);
+    pr_box s x = LocInfo (intloc(MLast.loc_of_class_sig_item s)) (HVbox x);
     pr_rules =
       extfun Extfun.empty with
       [ MLast.CgCtr _ t1 t2 ->
@@ -1834,7 +1836,7 @@ pr_class_expr.pr_levels :=
                   [: `HVbox [: `S LR "object"; `class_self_patt_opt csp :];
                      `HVbox
                         [: `HVbox [: :]; list class_str_item cf "" [: :];
-                           `LocInfo (ep, ep) (HVbox [: :]) :];
+                           `LocInfo (intloc(ep, ep)) (HVbox [: :]) :];
                      `HVbox [: `S LR "end"; k :] :] :]
       | MLast.CeTyc _ ce ct ->
           fun curr next dg k ->
@@ -2006,16 +2008,16 @@ value apply_printer printer ast =
         List.fold_left
           (fun (first, last_pos) (si, (bp, ep)) ->
              do {
-               copy_source ic oc first last_pos bp;
+               copy_source ic oc first last_pos.Lexing.pos_cnum bp.Lexing.pos_cnum;
                flush oc;
-               print_pretty pr_ch pr_str pr_nl "" "" maxl.val getcom bp
+               print_pretty pr_ch pr_str pr_nl "" "" maxl.val getcom bp.Lexing.pos_cnum
                  (printer si "" [: :]);
                flush oc;
                (False, ep)
              })
-          (True, 0) ast
+          (True, Token.nowhere) ast
       in
-      do { copy_to_end ic oc first last_pos; flush oc }
+      do { copy_to_end ic oc first last_pos.Lexing.pos_cnum; flush oc }
     with x ->
       do { close_in ic; cleanup (); raise x };
     close_in ic;
diff --git a/camlp4/etc/pr_op_main.ml b/camlp4/etc/pr_op_main.ml
index d7203e6e38..17049e74d0 100644
--- a/camlp4/etc/pr_op_main.ml
+++ b/camlp4/etc/pr_op_main.ml
@@ -15,7 +15,7 @@
 open Pcaml;
 open Spretty;
 
-value loc = (0, 0);
+value loc = (Token.nowhere, Token.nowhere);
 
 value expr e dg k = pr_expr.pr_fun "top" e dg k;
 value patt e dg k = pr_patt.pr_fun "top" e dg k;
diff --git a/camlp4/etc/pr_r.ml b/camlp4/etc/pr_r.ml
index bedff1936e..7a35ab8ca0 100644
--- a/camlp4/etc/pr_r.ml
+++ b/camlp4/etc/pr_r.ml
@@ -127,7 +127,7 @@ value flag n f = if f then [: `S LR n :] else [: :];
 
 (* default global loc *)
 
-value loc = (0, 0);
+value loc = (Token.nowhere, Token.nowhere);
 
 (* extensible printers *)
 
@@ -150,6 +150,8 @@ value class_type x k = pr_class_type.pr_fun "top" x "" k;
 value class_expr x k = pr_class_expr.pr_fun "top" x "" k;
 
 
+value intloc loc = ((fst loc).Lexing.pos_cnum, (snd loc).Lexing.pos_cnum);
+
 (* type core *)
 
 value rec labels loc b vl k =
@@ -158,13 +160,13 @@ value rec labels loc b vl k =
   | [v] ->
       [: `HVbox
             [: `HVbox [: :]; `label True b v [: :];
-               `LocInfo (snd loc, snd loc) (HVbox k) :] :]
+               `LocInfo (intloc(snd loc, snd loc)) (HVbox k) :] :]
   | [v :: l] -> [: `label False b v [: :]; labels loc [: :] l k :] ]
 and label is_last b (loc, f, m, t) k =
   let m = flag "mutable" m in
   let k = [: if is_last then [: :] else [: `S RO ";" :]; k :] in
   Hbox
-    [: `LocInfo loc
+    [: `LocInfo (intloc loc)
           (HVbox
              [: `HVbox [: b; `S LR f; `S LR ":" :];
                 `HVbox [: m; `ctyp t [: :] :] :]);
@@ -179,14 +181,14 @@ value rec variants loc b vl k =
   | [v] ->
       [: `HVbox
             [: `HVbox [: :]; `variant b v [: :];
-               `LocInfo (snd loc, snd loc) (HVbox k) :] :]
+               `LocInfo (intloc(snd loc, snd loc)) (HVbox k) :] :]
   | [v :: l] -> [: `variant b v [: :]; variants loc [: `S LR "|" :] l k :] ]
 and variant b (loc, c, tl) k =
   match tl with
-  [ [] -> HVbox [: `LocInfo loc (HVbox b); `HOVbox [: `S LR c; k :] :]
+  [ [] -> HVbox [: `LocInfo (intloc loc) (HVbox b); `HOVbox [: `S LR c; k :] :]
   | _ ->
       HVbox
-        [: `LocInfo loc (HVbox b);
+        [: `LocInfo (intloc loc) (HVbox b);
            `HOVbox [: `S LR c; `S LR "of"; ctyp_list tl k :] :] ]
 ;
 
@@ -321,7 +323,7 @@ and let_binding b (p, e) k =
     let (bp2, ep2) = MLast.loc_of_expr e in
     (min bp1 bp2, max ep1 ep2)
   in
-  LocInfo loc (BEbox [: let_binding0 [: b; `patt p [: :] :] e [: :]; k :])
+  LocInfo (intloc loc) (BEbox [: let_binding0 [: b; `patt p [: :] :] e [: :]; k :])
 and let_binding0 b e k =
   let (pl, e) = expr_fun_args e in
   match e with
@@ -603,7 +605,7 @@ and class_signature cs k =
       class_self_type [: `S LR "object" :] cst
         [: `HVbox
               [: `HVbox [: :]; list class_sig_item csf [: :];
-                 `LocInfo (ep, ep) (HVbox [: :]) :];
+                 `LocInfo (intloc(ep, ep)) (HVbox [: :]) :];
            `HVbox [: `S LR "end"; k :] :]
   | _ -> HVbox [: `not_impl "class_signature" cs; k :] ]
 and class_self_type b cst k =
@@ -658,7 +660,7 @@ pr_module_type.pr_levels :=
                   [: `S LR "sig";
                      `HVbox
                         [: `HVbox [: :]; list sig_item s [: :];
-                           `LocInfo (ep, ep) (HVbox [: :]) :];
+                           `LocInfo (intloc(ep, ep)) (HVbox [: :]) :];
                      `HVbox [: `S LR "end"; k :] :] :]
       | e -> fun curr next dg k -> [: `next e dg k :] ]};
    {pr_label = ""; pr_box s x = HVbox x;
@@ -695,7 +697,7 @@ pr_module_expr.pr_levels :=
             [: `HVbox [: :];
                `HVbox
                   [: `S LR "struct"; list str_item s [: :];
-                     `LocInfo (ep, ep) (HVbox [: :]) :];
+                     `LocInfo (intloc(ep, ep)) (HVbox [: :]) :];
                `HVbox [: `S LR "end"; k :] :]
       | <:module_expr< functor ($s$ : $mt$) -> $me$ >> ->
           fun curr next _ k ->
@@ -735,7 +737,7 @@ pr_module_expr.pr_levels :=
 
 pr_sig_item.pr_levels :=
   [{pr_label = "top";
-    pr_box s x = LocInfo (MLast.loc_of_sig_item s) (HVbox x);
+    pr_box s x = LocInfo (intloc(MLast.loc_of_sig_item s)) (HVbox x);
     pr_rules =
       extfun Extfun.empty with
       [ <:sig_item< type $list:stl$ >> ->
@@ -788,7 +790,7 @@ pr_sig_item.pr_levels :=
 
 pr_str_item.pr_levels :=
   [{pr_label = "top";
-    pr_box s x = LocInfo (MLast.loc_of_str_item s) (HVbox x);
+    pr_box s x = LocInfo (intloc(MLast.loc_of_str_item s)) (HVbox x);
     pr_rules =
       extfun Extfun.empty with
       [ <:str_item< open $i$ >> ->
@@ -885,7 +887,7 @@ END;
 *)
 
 pr_expr.pr_levels :=
-  [{pr_label = "top"; pr_box e x = LocInfo (MLast.loc_of_expr e) (HOVbox x);
+  [{pr_label = "top"; pr_box e x = LocInfo (intloc(MLast.loc_of_expr e)) (HOVbox x);
     pr_rules =
       extfun Extfun.empty with
       [ <:expr< let $opt:r$ $p1$ = $e1$ in $e$ >> ->
@@ -1163,7 +1165,7 @@ pr_expr.pr_levels :=
           fun curr next _ k -> [: curr e "" [: :]; `S NO "#"; `label lab; k :]
       | e -> fun curr next _ k -> [: `next e "" k :] ]};
    {pr_label = "simple";
-    pr_box e x = LocInfo (MLast.loc_of_expr e) (HOVbox x);
+    pr_box e x = LocInfo (intloc(MLast.loc_of_expr e)) (HOVbox x);
     pr_rules =
       extfun Extfun.empty with
       [ ( <:expr< $int:x$ >> | <:expr< $flo:x$ >> ) ->
@@ -1274,7 +1276,7 @@ pr_expr.pr_levels :=
 
 pr_patt.pr_levels :=
   [{pr_label = "top";
-    pr_box p x = LocInfo (MLast.loc_of_patt p) (HOVbox [: `HVbox [: :]; x :]);
+    pr_box p x = LocInfo (intloc(MLast.loc_of_patt p)) (HOVbox [: `HVbox [: :]; x :]);
     pr_rules =
       extfun Extfun.empty with
       [ <:patt< $x$ | $y$ >> ->
@@ -1301,7 +1303,7 @@ pr_patt.pr_levels :=
           fun curr next _ k -> [: curr x "" [: `S NO "." :]; `next y "" k :]
       | p -> fun curr next _ k -> [: `next p "" k :] ]};
    {pr_label = "simple";
-    pr_box p x = LocInfo (MLast.loc_of_patt p) (HOVbox x);
+    pr_box p x = LocInfo (intloc(MLast.loc_of_patt p)) (HOVbox x);
     pr_rules =
       extfun Extfun.empty with
       [ <:patt< [$_$ :: $_$] >> as p ->
@@ -1408,7 +1410,7 @@ pr_patt.pr_levels :=
       | p -> fun curr next _ k -> [: `next p "" k :] ]}];
 
 pr_ctyp.pr_levels :=
-  [{pr_label = "top"; pr_box t x = LocInfo (MLast.loc_of_ctyp t) (HOVbox x);
+  [{pr_label = "top"; pr_box t x = LocInfo (intloc(MLast.loc_of_ctyp t)) (HOVbox x);
     pr_rules =
       extfun Extfun.empty with
       [ <:ctyp< $t1$ == $t2$ >> ->
@@ -1460,7 +1462,7 @@ pr_ctyp.pr_levels :=
             [: curr t1 "" [: :]; `S NO "."; `next t2 "" k :]
       | t -> fun curr next _ k -> [: `next t "" k :] ]};
    {pr_label = "simple";
-    pr_box t x = LocInfo (MLast.loc_of_ctyp t) (HOVbox x);
+    pr_box t x = LocInfo (intloc(MLast.loc_of_ctyp t)) (HOVbox x);
     pr_rules =
       extfun Extfun.empty with
       [ <:ctyp< ($list:tl$) >> ->
@@ -1536,7 +1538,7 @@ pr_ctyp.pr_levels :=
 
 pr_class_sig_item.pr_levels :=
   [{pr_label = "top";
-    pr_box s x = LocInfo (MLast.loc_of_class_sig_item s) (HVbox x);
+    pr_box s x = LocInfo (intloc(MLast.loc_of_class_sig_item s)) (HVbox x);
     pr_rules =
       extfun Extfun.empty with
       [ <:class_sig_item< type $t1$ = $t2$ >> ->
@@ -1579,7 +1581,7 @@ pr_class_sig_item.pr_levels :=
 
 pr_class_str_item.pr_levels :=
   [{pr_label = "top";
-    pr_box s x = LocInfo (MLast.loc_of_class_str_item s) (HVbox x);
+    pr_box s x = LocInfo (intloc(MLast.loc_of_class_str_item s)) (HVbox x);
     pr_rules =
       extfun Extfun.empty with
       [ MLast.CrDcl _ s ->
@@ -1664,7 +1666,7 @@ pr_class_expr.pr_levels :=
                   [: `HVbox [: `S LR "object"; `class_self_patt_opt csp :];
                      `HVbox
                         [: `HVbox [: :]; list class_str_item cf [: :];
-                           `LocInfo (ep, ep) (HVbox [: :]) :];
+                           `LocInfo (intloc(ep, ep)) (HVbox [: :]) :];
                      `HVbox [: `S LR "end"; k :] :] :]
       | MLast.CeTyc _ ce ct ->
           fun curr next _ k ->
@@ -1838,16 +1840,16 @@ value apply_printer printer ast =
         List.fold_left
           (fun (first, last_pos) (si, (bp, ep)) ->
              do {
-               copy_source ic oc first last_pos bp;
+               copy_source ic oc first last_pos.Lexing.pos_cnum bp.Lexing.pos_cnum;
                flush oc;
-               print_pretty pr_ch pr_str pr_nl "" "" maxl.val getcom bp
+               print_pretty pr_ch pr_str pr_nl "" "" maxl.val getcom bp.Lexing.pos_cnum
                  (printer si [: :]);
                flush oc;
                (False, ep)
              })
-          (True, 0) ast
+          (True, Token.nowhere) ast
       in
-      do { copy_to_end ic oc first last_pos; flush oc }
+      do { copy_to_end ic oc first last_pos.Lexing.pos_cnum; flush oc }
     with x ->
       do { close_in ic; cleanup (); raise x };
     close_in ic;
diff --git a/camlp4/etc/pr_rp.ml b/camlp4/etc/pr_rp.ml
index 3487165e9f..f1782d2323 100644
--- a/camlp4/etc/pr_rp.ml
+++ b/camlp4/etc/pr_rp.ml
@@ -15,7 +15,7 @@
 open Pcaml;
 open Spretty;
 
-value loc = (0, 0);
+value loc = (Token.nowhere, Token.nowhere);
 
 value expr e dg k = pr_expr.pr_fun "top" e dg k;
 value patt e dg k = pr_patt.pr_fun "top" e dg k;
diff --git a/camlp4/etc/pr_rp_main.ml b/camlp4/etc/pr_rp_main.ml
index 11ad11af77..b1e737af6d 100644
--- a/camlp4/etc/pr_rp_main.ml
+++ b/camlp4/etc/pr_rp_main.ml
@@ -15,7 +15,7 @@
 open Pcaml;
 open Spretty;
 
-value loc = (0, 0);
+value loc = (Token.nowhere, Token.nowhere);
 
 value expr e dg k = pr_expr.pr_fun "top" e dg k;
 value patt e dg k = pr_patt.pr_fun "top" e dg k;
diff --git a/camlp4/etc/pr_scheme.ml b/camlp4/etc/pr_scheme.ml
index a7c2309488..7c5a230432 100644
--- a/camlp4/etc/pr_scheme.ml
+++ b/camlp4/etc/pr_scheme.ml
@@ -789,13 +789,13 @@ value apply_printer printer ast =
         List.fold_left
           (fun (first, last_pos) (si, (bp, ep)) ->
              do {
-               fprintf ppf "@[%a@]@?" copy_source (ic, first, last_pos, bp);
+               fprintf ppf "@[%a@]@?" copy_source (ic, first, last_pos.Lexing.pos_cnum, bp.Lexing.pos_cnum);
                fprintf ppf "@[%a@]@?" printer (si, nok);
                (False, ep)
              })
-          (True, 0) ast
+          (True, Token.nowhere) ast
       in
-      fprintf ppf "@[%a@]@?" copy_to_end (ic, first, last_pos)
+      fprintf ppf "@[%a@]@?" copy_to_end (ic, first, last_pos.Lexing.pos_cnum)
     with x ->
       do { fprintf ppf "@."; close_in ic; raise x };
     close_in ic;
diff --git a/camlp4/etc/q_phony.ml b/camlp4/etc/q_phony.ml
index 841e2bec90..85dd9545da 100644
--- a/camlp4/etc/q_phony.ml
+++ b/camlp4/etc/q_phony.ml
@@ -23,14 +23,14 @@ Quotation.add ""
           if t.val = "" then "<<" ^ s ^ ">>"
           else "<:" ^ t.val ^ "<" ^ s ^ ">>"
         in
-        let loc = (0, 0) in
+        let loc = (Token.nowhere, Token.nowhere) in
         <:expr< $uid:t$ >>,
       fun s ->
         let t =
           if t.val = "" then "<<" ^ s ^ ">>"
           else "<:" ^ t.val ^ "<" ^ s ^ ">>"
         in
-        let loc = (0, 0) in
+        let loc = (Token.nowhere, Token.nowhere) in
         <:patt< $uid:t$ >>))
 ;
 
diff --git a/camlp4/lib/.depend b/camlp4/lib/.depend
index 0d5adc691f..d7afaebeb2 100644
--- a/camlp4/lib/.depend
+++ b/camlp4/lib/.depend
@@ -2,6 +2,7 @@ extfold.cmi: gramext.cmi
 gramext.cmi: token.cmi 
 grammar.cmi: gramext.cmi token.cmi 
 plexer.cmi: token.cmi 
+stdpp.cmi: token.cmi 
 extfold.cmo: gramext.cmi grammar.cmi extfold.cmi 
 extfold.cmx: gramext.cmx grammar.cmx extfold.cmi 
 extfun.cmo: extfun.cmi 
@@ -14,7 +15,7 @@ grammar.cmo: gramext.cmi stdpp.cmi token.cmi grammar.cmi
 grammar.cmx: gramext.cmx stdpp.cmx token.cmx grammar.cmi 
 plexer.cmo: stdpp.cmi token.cmi plexer.cmi 
 plexer.cmx: stdpp.cmx token.cmx plexer.cmi 
-stdpp.cmo: stdpp.cmi 
-stdpp.cmx: stdpp.cmi 
+stdpp.cmo: token.cmi stdpp.cmi 
+stdpp.cmx: token.cmx stdpp.cmi 
 token.cmo: token.cmi 
 token.cmx: token.cmi 
diff --git a/camlp4/lib/Makefile b/camlp4/lib/Makefile
index ece72d1519..2a61589945 100644
--- a/camlp4/lib/Makefile
+++ b/camlp4/lib/Makefile
@@ -43,6 +43,6 @@ install:
 
 installopt:
 	cp $(TARGET:.cma=.cmxa) *.cmx "$(LIBDIR)/camlp4/."
-	tar cf - $(TARGET:.cma=.$(A)) | (cd "$(LIBDIR)/camlp4/."; tar xf -)
+	TARG=`echo "$(TARGET)" | sed -e "s/\.cma\$$/.$(A)/g"` && tar cf - $$TARG | (cd "$(LIBDIR)/camlp4/." && tar xf -)
 
 include .depend
diff --git a/camlp4/lib/grammar.ml b/camlp4/lib/grammar.ml
index b8c22d5073..f6d40bd9ef 100644
--- a/camlp4/lib/grammar.ml
+++ b/camlp4/lib/grammar.ml
@@ -203,14 +203,14 @@ external grammar_obj : g -> grammar Token.t = "%identity";
 value floc = ref (fun _ -> failwith "internal error when computing location");
 value loc_of_token_interval bp ep =
   if bp == ep then
-    if bp == 0 then (0, 1)
+    if bp == 0 then (Token.nowhere, Token.succ_pos Token.nowhere)
     else
       let a = snd (floc.val (bp - 1)) in
-      (a, a + 1)
+      (a, Token.succ_pos a)
   else
     let (bp1, bp2) = floc.val bp in
     let (ep1, ep2) = floc.val (pred ep) in
-    (if bp1 < ep1 then bp1 else ep1, if bp2 > ep2 then bp2 else ep2)
+    (if Token.lt_pos bp1 ep1 then bp1 else ep1, if Token.lt_pos ep2 bp2 then bp2 else ep2)
 ;
 
 value rec name_of_symbol entry =
@@ -737,8 +737,7 @@ value parse_parsable entry efun (cs, (ts, fun_loc)) =
       let loc = fun_loc cnt in
       if token_count.val - 1 <= cnt then loc
       else (fst loc, snd (fun_loc (token_count.val - 1)))
-    with _ ->
-      (Stream.count cs, Stream.count cs + 1)
+    with _ -> (Token.nowhere, Token.succ_pos Token.nowhere)
   in
   do {
     floc.val := fun_loc;
@@ -758,7 +757,7 @@ value parse_parsable entry efun (cs, (ts, fun_loc)) =
         let loc = get_loc () in
         do { restore (); raise_with_loc loc exc }
     | exc ->
-        let loc = (Stream.count cs, Stream.count cs + 1) in
+        let loc = (Token.nowhere, Token.succ_pos Token.nowhere) in
         do { restore (); raise_with_loc loc exc } ]
   }
 ;
@@ -1009,7 +1008,7 @@ module type ReinitType = sig value reinit_gram : g -> Token.lexer -> unit; end
 module GGMake (R : ReinitType) (L : GLexerType) =
   struct
     type te = L.te;
-    type parsable = (Stream.t char * (Stream.t te * Token.location_function));
+    type parsable = (Stream.t char * (Stream.t te * Token.flocation_function));
     value gram = gcreate L.lexer;
     value parsable cs = (cs, L.lexer.Token.tok_func cs);
     value tokens = tokens gram;
diff --git a/camlp4/lib/grammar.mli b/camlp4/lib/grammar.mli
index fe8345fb36..10074b9e7c 100644
--- a/camlp4/lib/grammar.mli
+++ b/camlp4/lib/grammar.mli
@@ -192,7 +192,7 @@ value create : Token.lexer -> g;
 
 (*** For system use *)
 
-value loc_of_token_interval : int -> int -> (int * int);
+value loc_of_token_interval : int -> int -> Token.flocation;
 value extend :
   list
     (Gramext.g_entry 'te * option Gramext.position *
diff --git a/camlp4/lib/plexer.ml b/camlp4/lib/plexer.ml
index 329380b267..7a4fb635c3 100644
--- a/camlp4/lib/plexer.ml
+++ b/camlp4/lib/plexer.ml
@@ -88,6 +88,9 @@ and digits_under kind len =
   parser
   [ [: d = kind; s :] -> digits_under kind (store len d) s
   | [: `'_'; s :] -> digits_under kind len s
+  | [: `'l' :] -> ("INT32", get_buff len)
+  | [: `'L' :] -> ("INT64", get_buff len)
+  | [: `'n' :] -> ("NATIVEINT", get_buff len)
   | [: :] -> ("INT", get_buff len) ]
 and octal = parser [ [: `('0'..'7' as d) :] -> d ]
 and hexa = parser [ [: `('0'..'9' | 'a'..'f' | 'A'..'F' as d) :] -> d ]
@@ -126,388 +129,102 @@ and end_exponent_part_under len =
 value error_on_unknown_keywords = ref False;
 value err loc msg = raise_with_loc loc (Token.Error msg);
 
-(*
-value next_token_fun dfa find_kwd =
-  let keyword_or_error loc s =
-    try (("", find_kwd s), loc) with
-    [ Not_found ->
-        if error_on_unknown_keywords.val then err loc ("illegal token: " ^ s)
-        else (("", s), loc) ]
-  in
-  let rec next_token =
-    parser bp
-    [ [: `' ' | '\010' | '\013' | '\t' | '\026' | '\012'; s :] ->
-        next_token s
-    | [: `'('; s :] -> left_paren bp s
-    | [: `'#'; s :] -> do { spaces_tabs s; linenum bp s }
-    | [: `('A'..'Z' | '\192'..'\214' | '\216'..'\222' as c); s :] ->
-        let id = get_buff (ident (store 0 c) s) in
-        let loc = (bp, Stream.count s) in
-        (try ("", find_kwd id) with [ Not_found -> ("UIDENT", id) ], loc)
-    | [: `('a'..'z' | '\223'..'\246' | '\248'..'\255' | '_' as c); s :] ->
-        let id = get_buff (ident (store 0 c) s) in
-        let loc = (bp, Stream.count s) in
-        (try ("", find_kwd id) with [ Not_found -> ("LIDENT", id) ], loc)
-    | [: `('1'..'9' as c); s :] ->
-        let tok = number (store 0 c) s in
-        let loc = (bp, Stream.count s) in
-        (tok, loc)
-    | [: `'0'; s :] ->
-        let tok = base_number (store 0 '0') s in
-        let loc = (bp, Stream.count s) in
-        (tok, loc)
-    | [: `'''; s :] ->
-        match Stream.npeek 3 s with
-        [ [_; '''; _] | ['\\'; _; _] | ['\x0D'; '\x0A'; '''] ->
-            let tok = ("CHAR", get_buff (char bp 0 s)) in
-            let loc = (bp, Stream.count s) in
-            (tok, loc)
-        | _ -> keyword_or_error (bp, Stream.count s) "'" ]
-    | [: `'"'; s :] ->
-        let tok = ("STRING", get_buff (string bp 0 s)) in
-        let loc = (bp, Stream.count s) in
-        (tok, loc)
-    | [: `'$'; s :] ->
-        let tok = dollar bp 0 s in
-        let loc = (bp, Stream.count s) in
-        (tok, loc)
-    | [: `('!' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | '%' as c);
-         s :] ->
-        let id = get_buff (ident2 (store 0 c) s) in
-        keyword_or_error (bp, Stream.count s) id
-    | [: `('~' as c);
-         a =
-           parser
-           [ [: `('a'..'z' as c); len = ident (store 0 c) :] ep ->
-               (("TILDEIDENT", get_buff len), (bp, ep))
-           | [: s :] ->
-               let id = get_buff (ident2 (store 0 c) s) in
-               keyword_or_error (bp, Stream.count s) id ] :] ->
-        a
-    | [: `('?' as c);
-         a =
-           parser
-           [ [: `('a'..'z' as c); len = ident (store 0 c) :] ep ->
-               (("QUESTIONIDENT", get_buff len), (bp, ep))
-           | [: s :] ->
-               let id = get_buff (ident2 (store 0 c) s) in
-               keyword_or_error (bp, Stream.count s) id ] :] ->
-        a
-    | [: `'<'; s :] -> less bp s
-    | [: `(':' as c1);
-         len =
-           parser
-           [ [: `(']' | ':' | '=' | '>' as c2) :] -> store (store 0 c1) c2
-           | [: :] -> store 0 c1 ] :] ep ->
-        let id = get_buff len in
-        keyword_or_error (bp, ep) id
-    | [: `('>' | '|' as c1);
-         len =
-           parser
-           [ [: `(']' | '}' as c2) :] -> store (store 0 c1) c2
-           | [: a = ident2 (store 0 c1) :] -> a ] :] ep ->
-        let id = get_buff len in
-        keyword_or_error (bp, ep) id
-    | [: `('[' | '{' as c1); s :] ->
-        let len =
-          match Stream.npeek 2 s with
-          [ ['<'; '<' | ':'] -> store 0 c1
-          | _ ->
-              match s with parser
-              [ [: `('|' | '<' | ':' as c2) :] -> store (store 0 c1) c2
-              | [: :] -> store 0 c1 ] ]
-        in
-        let ep = Stream.count s in
-        let id = get_buff len in
-        keyword_or_error (bp, ep) id
-    | [: `'.';
-         id =
-           parser
-           [ [: `'.' :] -> ".."
-           | [: :] -> if ssd && after_space then " ." else "." ] :] ep ->
-        keyword_or_error (bp, ep) id
-    | [: `';';
-         id =
-           parser
-           [ [: `';' :] -> ";;"
-           | [: :] -> ";" ] :] ep ->
-        keyword_or_error (bp, ep) id
-    | [: `'\\'; s :] ep -> (("LIDENT", get_buff (ident3 0 s)), (bp, ep))
-    | [: `c :] ep -> keyword_or_error (bp, ep) (String.make 1 c)
-    | [: _ = Stream.empty :] -> (("EOI", ""), (bp, succ bp)) ]
-  and less bp strm =
-    if no_quotations.val then
-      match strm with parser
-      [ [: len = ident2 (store 0 '<') :] ep ->
-          let id = get_buff len in
-          keyword_or_error (bp, ep) id ]
-    else
-      match strm with parser
-      [ [: `'<'; len = quotation bp 0 :] ep ->
-          (("QUOTATION", ":" ^ get_buff len), (bp, ep))
-      | [: `':'; i = parser [: len = ident 0 :] -> get_buff len;
-           `'<' ? "character '<' expected"; len = quotation bp 0 :] ep ->
-          (("QUOTATION", i ^ ":" ^ get_buff len), (bp, ep))
-      | [: len = ident2 (store 0 '<') :] ep ->
-          let id = get_buff len in
-          keyword_or_error (bp, ep) id ]
-  and string bp len =
-    parser
-    [ [: `'"' :] -> len
-    | [: `'\\'; `c; s :] -> string bp (store (store len '\\') c) s
-    | [: `c; s :] -> string bp (store len c) s
-    | [: :] ep -> err (bp, ep) "string not terminated" ]
-  and char bp len =
-    parser
-    [ [: `'''; s :] -> if len = 0 then char bp (store len ''') s else len
-    | [: `'\\'; `c; s :] -> char bp (store (store len '\\') c) s
-    | [: `c; s :] -> char bp (store len c) s
-    | [: :] ep -> err (bp, ep) "char not terminated" ]
-  and dollar bp len =
-    parser
-    [ [: `'$' :] -> ("ANTIQUOT", ":" ^ get_buff len)
-    | [: `('a'..'z' | 'A'..'Z' as c); s :] -> antiquot bp (store len c) s
-    | [: `('0'..'9' as c); s :] -> maybe_locate bp (store len c) s
-    | [: `':'; s :] ->
-        let k = get_buff len in
-        ("ANTIQUOT", k ^ ":" ^ locate_or_antiquot_rest bp 0 s)
-    | [: `'\\'; `c; s :] ->
-        ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s)
-    | [: s :] ->
-        if dfa then
-          match s with parser
-          [ [: `c :] ->
-              ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s)
-          | [: :] ep -> err (bp, ep) "antiquotation not terminated" ]
-        else ("", get_buff (ident2 (store 0 '$') s)) ]
-  and maybe_locate bp len =
-    parser
-    [ [: `'$' :] -> ("ANTIQUOT", ":" ^ get_buff len)
-    | [: `('0'..'9' as c); s :] -> maybe_locate bp (store len c) s
-    | [: `':'; s :] ->
-        ("LOCATE", get_buff len ^ ":" ^ locate_or_antiquot_rest bp 0 s)
-    | [: `'\\'; `c; s :] ->
-        ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s)
-    | [: `c; s :] ->
-        ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s)
-    | [: :] ep -> err (bp, ep) "antiquotation not terminated" ]
-  and antiquot bp len =
-    parser
-    [ [: `'$' :] -> ("ANTIQUOT", ":" ^ get_buff len)
-    | [: `('a'..'z' | 'A'..'Z' | '0'..'9' as c); s :] ->
-        antiquot bp (store len c) s
-    | [: `':'; s :] ->
-        let k = get_buff len in
-        ("ANTIQUOT", k ^ ":" ^ locate_or_antiquot_rest bp 0 s)
-    | [: `'\\'; `c; s :] ->
-        ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s)
-    | [: `c; s :] ->
-        ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s)
-    | [: :] ep -> err (bp, ep) "antiquotation not terminated" ]
-  and locate_or_antiquot_rest bp len =
-    parser
-    [ [: `'$' :] -> get_buff len
-    | [: `'\\'; `c; s :] -> locate_or_antiquot_rest bp (store len c) s
-    | [: `c; s :] -> locate_or_antiquot_rest bp (store len c) s
-    | [: :] ep -> err (bp, ep) "antiquotation not terminated" ]
-  and quotation bp len =
-    parser
-    [ [: `'>'; s :] -> maybe_end_quotation bp len s
-    | [: `'<'; s :] ->
-        quotation bp (maybe_nested_quotation bp (store len '<') s) s
-    | [: `'\\';
-         len =
-           parser
-           [ [: `('>' | '<' | '\\' as c) :] -> store len c
-           | [: :] -> store len '\\' ];
-         s :] ->
-        quotation bp len s
-    | [: `c; s :] -> quotation bp (store len c) s
-    | [: :] ep -> err (bp, ep) "quotation not terminated" ]
-  and maybe_nested_quotation bp len =
-    parser
-    [ [: `'<'; s :] -> mstore (quotation bp (store len '<') s) ">>"
-    | [: `':'; len = ident (store len ':');
-         a =
-           parser
-           [ [: `'<'; s :] -> mstore (quotation bp (store len '<') s) ">>"
-           | [: :] -> len ] :] ->
-        a
-    | [: :] -> len ]
-  and maybe_end_quotation bp len =
-    parser
-    [ [: `'>' :] -> len
-    | [: a = quotation bp (store len '>') :] -> a ]
-  and left_paren bp =
-    parser
-    [ [: `'*'; _ = comment bp; a = next_token True :] -> a
-    | [: :] ep -> keyword_or_error (bp, ep) "(" ]
-  and comment bp =
-    parser
-    [ [: `'('; s :] -> left_paren_in_comment bp s
-    | [: `'*'; s :] -> star_in_comment bp s
-    | [: `'"'; _ = string bp 0; s :] -> comment bp s
-    | [: `'''; s :] -> quote_in_comment bp s
-    | [: `c; s :] -> comment bp s
-    | [: :] ep -> err (bp, ep) "comment not terminated" ]
-  and quote_in_comment bp =
-    parser
-    [ [: `'''; s :] -> comment bp s
-    | [: `'\013'; s :] -> quote_cr_in_comment bp s
-    | [: `'\\'; s :] -> quote_antislash_in_comment bp s
-    | [: `'('; s :] -> quote_left_paren_in_comment bp s
-    | [: `'*'; s :] -> quote_star_in_comment bp s
-    | [: `'"'; s :] -> quote_doublequote_in_comment bp s
-    | [: `_; s :] -> quote_any_in_comment bp s
-    | [: s :] -> comment bp s ]
-  and quote_any_in_comment bp =
-    parser
-    [ [: `'''; s :] -> comment bp s
-    | [: s :] -> comment bp s ]
-  and quote_cr_in_comment bp =
-    parser
-    [ [: `'\010'; s :] -> quote_any_in_comment bp s
-    | [: s :] -> quote_any_in_comment bp s ]
-  and quote_left_paren_in_comment bp =
-    parser
-    [ [: `'''; s :] -> comment bp s
-    | [: s :] -> left_paren_in_comment bp s ]
-  and quote_star_in_comment bp =
-    parser
-    [ [: `'''; s :] -> comment bp s
-    | [: s :] -> star_in_comment bp s ]
-  and quote_doublequote_in_comment bp =
-    parser
-    [ [: `'''; s :] -> comment bp s
-    | [: _ = string bp 0; s :] -> comment bp s ]
-  and quote_antislash_in_comment bp =
-    parser
-    [ [: `'''; s :] -> quote_antislash_quote_in_comment bp s
-    | [: `('\\' | '"' | 'n' | 't' | 'b' | 'r'); s :] ->
-        quote_any_in_comment bp s
-    | [: `('0'..'9'); s :] -> quote_antislash_digit_in_comment bp s
-    | [: `'x'; s :] -> quote_antislash_x_in_comment bp s
-    | [: s :] -> comment bp s ]
-  and quote_antislash_quote_in_comment bp =
-    parser
-    [ [: `'''; s :] -> comment bp s
-    | [: s :] -> quote_in_comment bp s ]
-  and quote_antislash_digit_in_comment bp =
-    parser
-    [ [: `('0'..'9'); s :] -> quote_antislash_digit2_in_comment bp s
-    | [: s :] -> comment bp s ]
-  and quote_antislash_digit2_in_comment bp =
-    parser
-    [ [: `('0'..'9'); s :] -> quote_any_in_comment bp s
-    | [: s :] -> comment bp s ]
-  and quote_antislash_x_in_comment bp =
-    parser
-    [ [: _ = hexa; s :] -> quote_antislash_x_digit_in_comment bp s
-    | [: s :] -> comment bp s ]
-  and quote_antislash_x_digit_in_comment bp =
-    parser
-    [ [: _ = hexa; s :] -> quote_any_in_comment bp s
-    | [: s :] -> comment bp s ]
-  and left_paren_in_comment bp =
-    parser
-    [ [: `'*'; s :] -> do { comment bp s; comment bp s }
-    | [: a = comment bp :] -> a ]
-  and star_in_comment bp =
-    parser
-    [ [: `')' :] -> ()
-    | [: a = comment bp :] -> a ]
-  and linedir n s =
-    match stream_peek_nth n s with
-    [ Some (' ' | '\t') -> linedir (n + 1) s
-    | Some ('0'..'9') -> linedir_digits (n + 1) s
-    | _ -> False ]
-  and linedir_digits n s =
-    match stream_peek_nth n s with
-    [ Some ('0'..'9') -> linedir_digits (n + 1) s
-    | _ -> linedir_quote n s ]
-  and linedir_quote n s =
-    match stream_peek_nth n s with
-    [ Some (' ' | '\t') -> linedir_quote (n + 1) s
-    | Some '"' -> True
-    | _ -> False ]
-  and any_to_nl =
-    parser
-    [ [: `'\013' | '\010' :] ep -> bolpos.val := ep
-    | [: `_; s :] -> any_to_nl s
-    | [: :] -> () ]
-  in
-  fun cstrm ->
-    try
-      let glex = glexr.val in
-      let comm_bp = Stream.count cstrm in
-      let r = next_token False cstrm in
-      do {
-        match glex.tok_comm with
-        [ Some list ->
-            if fst (snd r) > comm_bp then
-              let comm_loc = (comm_bp, fst (snd r)) in
-              glex.tok_comm := Some [comm_loc :: list]
-            else ()
-        | None -> () ];
-        r
-      }
-    with
-    [ Stream.Error str ->
-        err (Stream.count cstrm, Stream.count cstrm + 1) str ]
+(* Debugging positions and locations *)
+value eprint_pos msg p =
+   Printf.eprintf "%s: fname=%s; lnum=%d; bol=%d; cnum=%d\n%!"
+     msg p.Lexing.pos_fname p.Lexing.pos_lnum p.Lexing.pos_bol p.Lexing.pos_cnum
+;
+
+value eprint_loc (bp, ep) =
+ do { eprint_pos "P1" bp; eprint_pos "P2" ep }
+;
+   
+value check_location msg ((bp, ep) as loc) =
+   let ok =
+     if (bp.Lexing.pos_lnum > ep.Lexing.pos_lnum ||
+         bp.Lexing.pos_bol > ep.Lexing.pos_bol ||
+         bp.Lexing.pos_cnum > ep.Lexing.pos_cnum ||
+         bp.Lexing.pos_lnum < 0 || ep.Lexing.pos_lnum < 0 ||
+         bp.Lexing.pos_bol < 0 || ep.Lexing.pos_bol < 0 ||
+         bp.Lexing.pos_cnum < 0 ||  ep.Lexing.pos_cnum < 0)
+         (* Here, we don't check
+            bp.Lexing.pos_cnum < bp.Lexing.pos_bol || ep.Lexing.pos_cnum < bp.Lexing.pos_bol
+            since the lexer is called on antiquotations, with cnum=0, but lnum and bolpos
+            have "correct" values *)
+     then
+       do {
+         Printf.eprintf "*** Warning: (%s) strange positions ***\n" msg;
+         eprint_loc loc;
+         False
+          }
+     else
+       True in
+   (ok, loc)
 ;
-*)
 
-value next_token_fun dfa ssd find_kwd bolpos glexr =
-  let keyword_or_error loc s =
-    try (("", find_kwd s), loc) with
-    [ Not_found ->
+value next_token_fun dfa ssd find_kwd fname lnum bolpos glexr =
+   let make_pos p =
+     {Lexing.pos_fname = fname.val; Lexing.pos_lnum = lnum.val;
+      Lexing.pos_bol = bolpos.val; Lexing.pos_cnum = p} in
+   let mkloc (bp, ep) = (make_pos bp, make_pos ep) in
+   let keyword_or_error (bp,ep) s =
+    let loc = mkloc (bp, ep) in
+      try (("", find_kwd s), loc) with
+      [ Not_found ->
         if error_on_unknown_keywords.val then err loc ("illegal token: " ^ s)
         else (("", s), loc) ] in
-  let error_if_keyword ( ((_,id), loc) as a) =
+  let error_if_keyword ( ((_,id) as a), bep) =
+    let loc = mkloc bep in
     try do {
       ignore(find_kwd id);
       err loc ("illegal use of a keyword as a label: " ^ id) }
-    with [ Not_found -> a ]
+    with [ Not_found -> (a, loc) ]
   in
   let rec next_token after_space =
     parser bp
-    [ [: `'\010' | '\013'; s :] ep ->
-        do { bolpos.val := ep; next_token True s }
+    [ [: `'\010'; s :] ep ->
+        do { bolpos.val := ep; incr lnum; next_token True s }
+    | [: `'\013'; s :] ep ->
+        let ep =
+          match Stream.peek s with
+            [ Some '\010' -> do { Stream.junk s; ep+1 }
+            | _ -> ep ] in
+        do { bolpos.val := ep; incr lnum; next_token True s }
     | [: `' ' | '\t' | '\026' | '\012'; s :] -> next_token True s
     | [: `'#' when bp = bolpos.val; s :] ->
-        if linedir 1 s then do { any_to_nl s; next_token True s }
+        if linedir 1 s then do { line_directive s; next_token True s }
         else keyword_or_error (bp, bp + 1) "#"
     | [: `'('; s :] -> left_paren bp s
     | [: `('A'..'Z' | '\192'..'\214' | '\216'..'\222' as c); s :] ->
         let id = get_buff (ident (store 0 c) s) in
-        let loc = (bp, Stream.count s) in
+        let loc = mkloc (bp, (Stream.count s)) in
         (try ("", find_kwd id) with [ Not_found -> ("UIDENT", id) ], loc)
     | [: `('a'..'z' | '\223'..'\246' | '\248'..'\255' | '_' as c); s :] ->
         let id = get_buff (ident (store 0 c) s) in
-        let loc = (bp, Stream.count s) in
+        let loc = mkloc (bp, (Stream.count s)) in
         (try ("", find_kwd id) with [ Not_found -> ("LIDENT", id) ], loc)
     | [: `('1'..'9' as c); s :] ->
         let tok = number (store 0 c) s in
-        let loc = (bp, Stream.count s) in
+        let loc = mkloc (bp, (Stream.count s)) in
         (tok, loc)
     | [: `'0'; s :] ->
         let tok = base_number (store 0 '0') s in
-        let loc = (bp, Stream.count s) in
+        let loc = mkloc (bp, (Stream.count s)) in
         (tok, loc)
     | [: `'''; s :] ->
         match Stream.npeek 2 s with
         [ [_; '''] | ['\\'; _] ->
             let tok = ("CHAR", get_buff (char bp 0 s)) in
-            let loc = (bp, Stream.count s) in
+            let loc = mkloc (bp, (Stream.count s)) in
             (tok, loc)
         | _ -> keyword_or_error (bp, Stream.count s) "'" ]
     | [: `'"'; s :] ->
         let tok = ("STRING", get_buff (string bp 0 s)) in
-        let loc = (bp, Stream.count s) in
+        let loc = mkloc (bp, Stream.count s) in
         (tok, loc)
     | [: `'$'; s :] ->
         let tok = dollar bp 0 s in
-        let loc = (bp, Stream.count s) in
+        let loc = mkloc (bp, Stream.count s) in
         (tok, loc)
     | [: `('!' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | '%' as c);
          s :] ->
@@ -519,7 +236,7 @@ value next_token_fun dfa ssd find_kwd bolpos glexr =
            [ [: `('a'..'z' as c); len = ident (store 0 c); s :] ep ->
                let id = get_buff len in
                match s with parser
-               [ [: `':' :] eb -> error_if_keyword (("LABEL", id), (bp,ep))
+               [ [: `':' :] eb -> error_if_keyword (("LABEL", id), (bp, ep))
                | [: :] -> error_if_keyword (("TILDEIDENT", id), (bp, ep)) ]
            | [: s :] ->
                let id = get_buff (ident2 (store 0 c) s) in
@@ -577,9 +294,9 @@ value next_token_fun dfa ssd find_kwd bolpos glexr =
            [ [: `';' :] -> ";;"
            | [: :] -> ";" ] :] ep ->
         keyword_or_error (bp, ep) id
-    | [: `'\\'; s :] ep -> (("LIDENT", get_buff (ident3 0 s)), (bp, ep))
+    | [: `'\\'; s :] ep -> (("LIDENT", get_buff (ident3 0 s)), mkloc (bp, ep))
     | [: `c :] ep -> keyword_or_error (bp, ep) (String.make 1 c)
-    | [: _ = Stream.empty :] -> (("EOI", ""), (bp, succ bp)) ]
+    | [: _ = Stream.empty :] -> (("EOI", ""), mkloc (bp, succ bp)) ]
   and less bp strm =
     if no_quotations.val then
       match strm with parser
@@ -589,10 +306,10 @@ value next_token_fun dfa ssd find_kwd bolpos glexr =
     else
       match strm with parser
       [ [: `'<'; len = quotation bp 0 :] ep ->
-          (("QUOTATION", ":" ^ get_buff len), (bp, ep))
+          (("QUOTATION", ":" ^ get_buff len), mkloc (bp, ep))
       | [: `':'; i = parser [: len = ident 0 :] -> get_buff len;
            `'<' ? "character '<' expected"; len = quotation bp 0 :] ep ->
-          (("QUOTATION", i ^ ":" ^ get_buff len), (bp, ep))
+          (("QUOTATION", i ^ ":" ^ get_buff len), mkloc (bp, ep))
       | [: len = ident2 (store 0 '<') :] ep ->
           let id = get_buff len in
           keyword_or_error (bp, ep) id ]
@@ -600,14 +317,28 @@ value next_token_fun dfa ssd find_kwd bolpos glexr =
     parser
     [ [: `'"' :] -> len
     | [: `'\\'; `c; s :] ep  -> string bp (store (store len '\\') c) s
+    | [: `'\010'; s :] ep -> do { bolpos.val := ep; incr lnum; string bp len s }
+    | [: `'\013'; s :] ep ->
+        let (len, ep) =
+          match Stream.peek s with
+            [ Some '\010' -> do { Stream.junk s; (store (store len '\013') '\010', ep+1) }
+            | _ -> (store len '\013', ep) ] in
+        do { bolpos.val := ep; incr lnum; string bp len s }
     | [: `c; s :] -> string bp (store len c) s
-    | [: :] ep -> err (bp, ep) "string not terminated" ]
+    | [: :] ep -> err (mkloc (bp, ep)) "string not terminated" ]
   and char bp len =
     parser
     [ [: `'''; s :] -> if len = 0 then char bp (store len ''') s else len
     | [: `'\\'; `c; s :] -> char bp (store (store len '\\') c) s
+    | [: `'\010'; s :] -> do {bolpos.val := bp+1; incr lnum; char bp (store len '\010') s}
+    | [: `'\013'; s :] ->
+        let bol =
+          match Stream.peek s with
+            [ Some '\010' -> do { Stream.junk s; bp+2 }
+            | _ -> bp+1 ] in
+        do { bolpos.val := bol; incr lnum; char bp (store len '\013') s}
     | [: `c; s :] -> char bp (store len c) s
-    | [: :] ep -> err (bp, ep) "char not terminated" ]
+    | [: :] ep -> err (mkloc (bp, ep)) "char not terminated" ]
   and dollar bp len =
     parser
     [ [: `'$' :] -> ("ANTIQUOT", ":" ^ get_buff len)
@@ -623,7 +354,7 @@ value next_token_fun dfa ssd find_kwd bolpos glexr =
           match s with parser
           [ [: `c :] ->
               ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s)
-          | [: :] ep -> err (bp, ep) "antiquotation not terminated" ]
+          | [: :] ep -> err (mkloc (bp, ep)) "antiquotation not terminated" ]
         else ("", get_buff (ident2 (store 0 '$') s)) ]
   and maybe_locate bp len =
     parser
@@ -635,7 +366,7 @@ value next_token_fun dfa ssd find_kwd bolpos glexr =
         ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s)
     | [: `c; s :] ->
         ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s)
-    | [: :] ep -> err (bp, ep) "antiquotation not terminated" ]
+    | [: :] ep -> err (mkloc (bp, ep)) "antiquotation not terminated" ]
   and antiquot bp len =
     parser
     [ [: `'$' :] -> ("ANTIQUOT", ":" ^ get_buff len)
@@ -648,13 +379,13 @@ value next_token_fun dfa ssd find_kwd bolpos glexr =
         ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s)
     | [: `c; s :] ->
         ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s)
-    | [: :] ep -> err (bp, ep) "antiquotation not terminated" ]
+    | [: :] ep -> err (mkloc (bp, ep)) "antiquotation not terminated" ]
   and locate_or_antiquot_rest bp len =
     parser
     [ [: `'$' :] -> get_buff len
     | [: `'\\'; `c; s :] -> locate_or_antiquot_rest bp (store len c) s
     | [: `c; s :] -> locate_or_antiquot_rest bp (store len c) s
-    | [: :] ep -> err (bp, ep) "antiquotation not terminated" ]
+    | [: :] ep -> err (mkloc (bp, ep)) "antiquotation not terminated" ]
   and quotation bp len =
     parser
     [ [: `'>'; s :] -> maybe_end_quotation bp len s
@@ -668,7 +399,7 @@ value next_token_fun dfa ssd find_kwd bolpos glexr =
          s :] ->
         quotation bp len s
     | [: `c; s :] -> quotation bp (store len c) s
-    | [: :] ep -> err (bp, ep) "quotation not terminated" ]
+    | [: :] ep -> err (mkloc (bp, ep)) "quotation not terminated" ]
   and maybe_nested_quotation bp len =
     parser
     [ [: `'<'; s :] -> mstore (quotation bp (store len '<') s) ">>"
@@ -693,8 +424,15 @@ value next_token_fun dfa ssd find_kwd bolpos glexr =
     | [: `'*'; s :] -> star_in_comment bp s
     | [: `'"'; _ = string bp 0; s :] -> comment bp s
     | [: `'''; s :] -> quote_in_comment bp s
+    | [: `'\010'; s :] ep -> do { bolpos.val := ep; incr lnum; comment bp s }
+    | [: `'\013'; s :] ep ->
+        let ep =
+          match Stream.peek s with
+            [ Some '\010' -> do { Stream.junk s; ep+1 }
+            | _ -> ep ] in
+        do { bolpos.val := ep; incr lnum; comment bp s }
     | [: `c; s :] -> comment bp s
-    | [: :] ep -> err (bp, ep) "comment not terminated" ]
+    | [: :] ep -> err (mkloc (bp, ep)) "comment not terminated" ]
   and quote_in_comment bp =
     parser
     [ [: `'''; s :] -> comment bp s
@@ -702,7 +440,15 @@ value next_token_fun dfa ssd find_kwd bolpos glexr =
     | [: s :] ->
         do {
           match Stream.npeek 2 s with
-          [ [_; '''] -> do { Stream.junk s; Stream.junk s }
+          [ [ ( '\013' | '\010' ); '''] ->
+            do { bolpos.val := bp + 1; incr lnum;
+                 Stream.junk s; Stream.junk s }
+          | [ '\013'; '\010' ] ->
+               match Stream.npeek 3 s with
+                 [ [_; _; '''] -> do { bolpos.val := bp + 2; incr lnum;
+                                       Stream.junk s; Stream.junk s; Stream.junk s }
+                 | _ -> () ]
+          | [_; '''] -> do { Stream.junk s; Stream.junk s }
           | _ -> () ];
           comment bp s
         } ]
@@ -736,22 +482,42 @@ value next_token_fun dfa ssd find_kwd bolpos glexr =
   and linedir n s =
     match stream_peek_nth n s with
     [ Some (' ' | '\t') -> linedir (n + 1) s
-    | Some ('0'..'9') -> linedir_digits (n + 1) s
-    | _ -> False ]
-  and linedir_digits n s =
-    match stream_peek_nth n s with
-    [ Some ('0'..'9') -> linedir_digits (n + 1) s
-    | _ -> linedir_quote n s ]
-  and linedir_quote n s =
-    match stream_peek_nth n s with
-    [ Some (' ' | '\t') -> linedir_quote (n + 1) s
-    | Some '"' -> True
+    | Some ('0'..'9') -> True
     | _ -> False ]
   and any_to_nl =
     parser
-    [ [: `'\013' | '\010' :] ep -> bolpos.val := ep
+    [ [: `'\010'; s :] ep ->
+        do { bolpos.val := ep; incr lnum }
+    | [: `'\013'; s :] ep ->
+        let ep =
+          match Stream.peek s with
+            [ Some '\010' -> do { Stream.junk s; ep+1 }
+            | _ -> ep ] in
+        do { bolpos.val := ep; incr lnum }
     | [: `_; s :] -> any_to_nl s
     | [: :] -> () ]
+  and line_directive = parser (* we are sure that there is a line directive here *)
+    [ [: _ = skip_spaces; n = line_directive_number 0;
+         _ = skip_spaces; _ = line_directive_string;
+         _ = any_to_nl :] ep
+       -> do { bolpos.val := ep; lnum.val := n }
+    ]
+  and skip_spaces = parser
+    [ [: `' ' | '\t'; s :] -> skip_spaces s
+    | [: :] -> () ]
+  and line_directive_number n = parser
+    [ [: `('0'..'9' as c) ; s :]
+      -> line_directive_number (10*n + (Char.code c - Char.code '0')) s
+    | [: :] -> n ]
+  and line_directive_string = parser
+    [ [: ` '"' ; _ = line_directive_string_contents 0 :] -> ()
+    | [: :] -> ()
+   ]
+  and line_directive_string_contents len = parser
+    [ [: ` '\010' | '\013' :]  -> ()
+    | [: ` '"' :] -> fname.val := get_buff len
+    | [: `c; s :] -> line_directive_string_contents (store len c) s
+    ]
   in
   fun cstrm ->
     try
@@ -761,8 +527,9 @@ value next_token_fun dfa ssd find_kwd bolpos glexr =
       do {
         match glex.tok_comm with
         [ Some list ->
-            if fst (snd r) > comm_bp then
-              let comm_loc = (comm_bp, fst (snd r)) in
+            let next_bp = (fst (snd r)).Lexing.pos_cnum in
+            if next_bp > comm_bp then
+              let comm_loc = mkloc (comm_bp, next_bp) in
               glex.tok_comm := Some [comm_loc :: list]
             else ()
         | None -> () ];
@@ -770,7 +537,7 @@ value next_token_fun dfa ssd find_kwd bolpos glexr =
       }
     with
     [ Stream.Error str ->
-        err (Stream.count cstrm, Stream.count cstrm + 1) str ]
+        err (mkloc (Stream.count cstrm, Stream.count cstrm + 1)) str ]
 ;
 
 
@@ -779,10 +546,12 @@ value specific_space_dot = ref False;
 
 value func kwd_table glexr =
   let bolpos = ref 0 in
+  let lnum = ref 1 in
+  let fname = ref "" in
   let find = Hashtbl.find kwd_table in
   let dfa = dollar_for_antiquotation.val in
   let ssd = specific_space_dot.val in
-  Token.lexer_func_of_parser (next_token_fun dfa ssd find bolpos glexr)
+  Token.lexer_func_of_parser (next_token_fun dfa ssd find fname lnum bolpos glexr)
 ;
 
 value rec check_keyword_stream =
diff --git a/camlp4/lib/stdpp.ml b/camlp4/lib/stdpp.ml
index a89cb15d8e..665dac1f30 100644
--- a/camlp4/lib/stdpp.ml
+++ b/camlp4/lib/stdpp.ml
@@ -12,7 +12,7 @@
 
 (* $Id$ *)
 
-exception Exc_located of (int * int) and exn;
+exception Exc_located of Token.flocation and exn;
 
 value raise_with_loc loc exc =
   match exc with
@@ -21,6 +21,14 @@ value raise_with_loc loc exc =
 ;
 
 value line_of_loc fname (bp, ep) =
+  (bp.Lexing.pos_fname,
+   bp.Lexing.pos_lnum,
+   bp.Lexing.pos_cnum - bp.Lexing.pos_bol,
+   ep.Lexing.pos_cnum - bp.Lexing.pos_bol)
+;
+
+(*
+value line_of_loc fname (bp, ep) =
   try
     let ic = open_in_bin fname in
     let strm = Stream.of_channel ic in
@@ -75,5 +83,6 @@ value line_of_loc fname (bp, ep) =
   with
   [ Sys_error _ -> (fname, 1, bp, ep) ]
 ;
+*)
 
 value loc_name = ref "loc";
diff --git a/camlp4/lib/stdpp.mli b/camlp4/lib/stdpp.mli
index 069e56bee3..a260cc69df 100644
--- a/camlp4/lib/stdpp.mli
+++ b/camlp4/lib/stdpp.mli
@@ -14,18 +14,18 @@
 
 (** Standard definitions. *)
 
-exception Exc_located of (int * int) and exn;
+exception Exc_located of Token.flocation and exn;
    (** [Exc_located loc e] is an encapsulation of the exception [e] with
        the input location [loc]. To be used in quotation expanders
        and in grammars to specify some input location for an error.
        Do not raise this exception directly: rather use the following
        function [raise_with_loc]. *)
 
-value raise_with_loc : (int * int) -> exn -> 'a;
+value raise_with_loc : Token.flocation -> exn -> 'a;
    (** [raise_with_loc loc e], if [e] is already the exception [Exc_located],
        re-raise it, else raise the exception [Exc_located loc e]. *)
 
-value line_of_loc : string -> (int * int) -> (string * int * int * int);
+value line_of_loc : string -> Token.flocation -> (string * int * int * int);
    (** [line_of_loc fname loc] reads the file [fname] up to the
        location [loc] and returns the real input file, the line number
        and the characters location in the line; the real input file
diff --git a/camlp4/lib/token.ml b/camlp4/lib/token.ml
index e26798af9c..5bfc6541f1 100644
--- a/camlp4/lib/token.ml
+++ b/camlp4/lib/token.ml
@@ -17,9 +17,23 @@ type pattern = (string * string);
 
 exception Error of string;
 
-type location = (int * int);
-type location_function = int -> (int * int);
-type lexer_func 'te = Stream.t char -> (Stream.t 'te * location_function);
+value make_loc (bp, ep) =
+   ({ (Lexing.dummy_pos) with Lexing.pos_cnum = bp; Lexing.pos_lnum = 1 },
+    { (Lexing.dummy_pos) with Lexing.pos_cnum = ep; Lexing.pos_lnum = 1 })
+;
+
+value nowhere = { (Lexing.dummy_pos) with Lexing.pos_cnum = 0 };
+
+value dummy_loc = (Lexing.dummy_pos, Lexing.dummy_pos);
+
+value succ_pos p =
+    { ( p ) with Lexing.pos_cnum = p.Lexing.pos_cnum + 1};
+value lt_pos p1 p2 = p1.Lexing.pos_cnum < p2.Lexing.pos_cnum;
+
+type flocation = (Lexing.position * Lexing.position);
+
+type flocation_function = int -> flocation;
+type lexer_func 'te = Stream.t char -> (Stream.t 'te * flocation_function);
 
 type glexer 'te =
   { tok_func : lexer_func 'te;
@@ -27,7 +41,7 @@ type glexer 'te =
     tok_removing : pattern -> unit;
     tok_match : pattern -> 'te -> string;
     tok_text : pattern -> string;
-    tok_comm : mutable option (list location) }
+    tok_comm : mutable option (list flocation) }
 ;
 type lexer =
   { func : lexer_func t;
@@ -43,31 +57,41 @@ value lexer_text (con, prm) =
   else con ^ " '" ^ prm ^ "'"
 ;
 
-value locerr () = invalid_arg "Lexer: location function";
-value loct_create () = (ref (Array.create 1024 None), ref False);
+value locerr () = invalid_arg "Lexer: flocation function";
+
+value tsz = 256; (* up to 2^29 entries on a 32-bit machine, 2^61 on 64-bit *)
+
+value loct_create () = (ref [| |], ref False);
+
 value loct_func (loct, ov) i =
   match
-    if i < 0 || i >= Array.length loct.val then
-      if ov.val then Some (0, 0) else None
-    else Array.unsafe_get loct.val i
+    if i < 0 || i/tsz >= Array.length loct.val then None
+    else if loct.val.(i/tsz) = [| |] then
+      if ov.val then Some (nowhere, nowhere) else  None
+    else Array.unsafe_get (Array.unsafe_get loct.val (i/tsz)) (i mod tsz)
   with
   [ Some loc -> loc
   | _ -> locerr () ]
 ;
-value loct_add (loct, ov) i loc =
-  if i >= Array.length loct.val then
-    let new_tmax = Array.length loct.val * 2 in
+
+value loct_add (loct, ov) i loc = do {
+  while i/tsz >= Array.length loct.val && (not ov.val) do {
+    let new_tmax = Array.length loct.val * 2 + 1 in
     if new_tmax < Sys.max_array_length then do {
-      let new_loct = Array.create new_tmax None in
+      let new_loct = Array.make new_tmax [| |] in
       Array.blit loct.val 0 new_loct 0 (Array.length loct.val);
-      loct.val := new_loct;
-      loct.val.(i) := Some loc
-    }
-    else ov.val := True
-  else loct.val.(i) := Some loc
-;
+      loct.val := new_loct
+    } else ov.val := True
+  };
+  if not(ov.val) then do {
+    if loct.val.(i/tsz) = [| |] then
+      loct.val.(i/tsz) := Array.make tsz None
+    else ();
+    loct.val.(i/tsz).(i mod tsz) := Some loc
+  } else ()
+};
 
-value make_stream_and_location next_token_loc =
+value make_stream_and_flocation next_token_loc =
   let loct = loct_create () in
   let ts =
     Stream.from
@@ -79,7 +103,7 @@ value make_stream_and_location next_token_loc =
 ;
 
 value lexer_func_of_parser next_token_loc cs =
-  make_stream_and_location (fun () -> next_token_loc cs)
+  make_stream_and_flocation (fun () -> next_token_loc cs)
 ;
 
 value lexer_func_of_ocamllex lexfun cs =
@@ -90,10 +114,10 @@ value lexer_func_of_ocamllex lexfun cs =
   in
   let next_token_loc _ =
     let tok = lexfun lb in
-    let loc = (Lexing.lexeme_start lb, Lexing.lexeme_end lb) in
+    let loc = (Lexing.lexeme_start_p lb, Lexing.lexeme_end_p lb) in
     (tok, loc)
   in
-  make_stream_and_location next_token_loc
+  make_stream_and_flocation next_token_loc
 ;
 
 (* Char and string tokens to real chars and string *)
@@ -209,7 +233,7 @@ value eval_string  (bp, ep) s =
                 [ Not_found -> do {
                     Printf.eprintf
                      "Warning: char %d, Invalid backslash escape in string\n%!"
-                     (bp+i+1);
+                     (bp.Lexing.pos_cnum + i + 1);
                     (store (store len '\\') c, i + 1) } ] ]
         else (store len s.[i], i + 1)
       in
diff --git a/camlp4/lib/token.mli b/camlp4/lib/token.mli
index fbd1aefd30..db025d0f2f 100644
--- a/camlp4/lib/token.mli
+++ b/camlp4/lib/token.mli
@@ -33,11 +33,19 @@ exception Error of string;
 
 (** {6 Lexer type} *)
 
-type location = (int * int);
-type location_function = int -> location;
+type flocation = (Lexing.position * Lexing.position);
+
+value nowhere : Lexing.position;
+value dummy_loc : flocation;
+
+value make_loc : (int * int) -> flocation;
+value succ_pos : Lexing.position ->  Lexing.position;
+value lt_pos : Lexing.position ->  Lexing.position -> bool;
+
+type flocation_function = int -> flocation;
   (** The type for a function associating a number of a token in a stream
       (starting from 0) to its source location. *)
-type lexer_func 'te = Stream.t char -> (Stream.t 'te * location_function);
+type lexer_func 'te = Stream.t char -> (Stream.t 'te * flocation_function);
   (** The type for a lexer function. The character stream is the input
       stream to be lexed. The result is a pair of a token stream and
       a location function for this tokens stream. *)
@@ -48,7 +56,7 @@ type glexer 'te =
     tok_removing : pattern -> unit;
     tok_match : pattern -> 'te -> string;
     tok_text : pattern -> string;
-    tok_comm : mutable option (list location) }
+    tok_comm : mutable option (list flocation) }
 ;
    (** The type for a lexer used by Camlp4 grammars.
 -      The field [tok_func] is the main lexer function. See [lexer_func]
@@ -96,14 +104,14 @@ value default_match : pattern -> (string * string) -> string;
    as well. *)
 
 value lexer_func_of_parser :
-  (Stream.t char -> ('te * location)) -> lexer_func 'te;
+  (Stream.t char -> ('te * flocation)) -> lexer_func 'te;
    (** A lexer function from a lexer written as a char stream parser
        returning the next token and its location. *)
 value lexer_func_of_ocamllex : (Lexing.lexbuf -> 'te) -> lexer_func 'te;
    (** A lexer function from a lexer created by [ocamllex] *)
 
-value make_stream_and_location :
-  (unit -> ('te * location)) -> (Stream.t 'te * location_function);
+value make_stream_and_flocation :
+  (unit -> ('te * flocation)) -> (Stream.t 'te * flocation_function);
    (** General function *)
 
 (** {6 Useful functions} *)
@@ -114,7 +122,7 @@ value eval_char : string -> char;
        incorrect backslash sequence is found; [Token.eval_char (Char.escaped c)]
        returns [c] *)
 
-value eval_string : location -> string -> string;
+value eval_string : flocation -> string -> string;
    (** Convert a string token, where the escape sequences (backslashes)
        remain to be interpreted; issue a warning if an incorrect
        backslash sequence is found;
diff --git a/camlp4/meta/.depend b/camlp4/meta/.depend
index 737ea5ec6b..7c8bcbfbea 100644
--- a/camlp4/meta/.depend
+++ b/camlp4/meta/.depend
@@ -1,5 +1,5 @@
-pa_extend.cmo: ../camlp4/mLast.cmi ../camlp4/pcaml.cmi 
-pa_extend.cmx: ../camlp4/mLast.cmi ../camlp4/pcaml.cmx 
+pa_extend.cmo: ../camlp4/mLast.cmi ../camlp4/pcaml.cmi ../camlp4/reloc.cmi 
+pa_extend.cmx: ../camlp4/mLast.cmi ../camlp4/pcaml.cmx ../camlp4/reloc.cmx 
 pa_extend_m.cmo: pa_extend.cmo 
 pa_extend_m.cmx: pa_extend.cmx 
 pa_ifdef.cmo: ../camlp4/mLast.cmi ../camlp4/pcaml.cmi 
@@ -12,5 +12,7 @@ pa_rp.cmo: ../camlp4/mLast.cmi ../camlp4/pcaml.cmi
 pa_rp.cmx: ../camlp4/mLast.cmi ../camlp4/pcaml.cmx 
 pr_dump.cmo: ../camlp4/ast2pt.cmi $(OTOP)/utils/config.cmi ../camlp4/pcaml.cmi 
 pr_dump.cmx: ../camlp4/ast2pt.cmx $(OTOP)/utils/config.cmx ../camlp4/pcaml.cmx 
-q_MLast.cmo: ../camlp4/mLast.cmi ../camlp4/pcaml.cmi ../camlp4/quotation.cmi 
-q_MLast.cmx: ../camlp4/mLast.cmi ../camlp4/pcaml.cmx ../camlp4/quotation.cmx 
+q_MLast.cmo: ../camlp4/mLast.cmi ../camlp4/pcaml.cmi ../camlp4/quotation.cmi \
+    ../camlp4/reloc.cmi 
+q_MLast.cmx: ../camlp4/mLast.cmi ../camlp4/pcaml.cmx ../camlp4/quotation.cmx \
+    ../camlp4/reloc.cmx 
diff --git a/camlp4/meta/Makefile b/camlp4/meta/Makefile
index ba1481bed7..2469a35330 100644
--- a/camlp4/meta/Makefile
+++ b/camlp4/meta/Makefile
@@ -49,11 +49,7 @@ install:
 	cp camlp4r$(EXE) "$(BINDIR)/."
 	if test -f camlp4r.opt; then \
 	  cp camlp4r.opt "$(BINDIR)/camlp4r.opt$(EXE)" ;\
-	  for target in $(OBJSX) $(OBJSX:.cmx=.$(O)) ; do \
-	    if test -f $$target; then \
-	      cp $$target "$(LIBDIR)/camlp4/."; \
-	    fi; \
-	  done; \
+	  cp $(OBJSX) $(OBJSX:.cmx=.$(O)) "$(LIBDIR)/camlp4/."; \
 	fi
 
 include .depend
diff --git a/camlp4/meta/pa_extend.ml b/camlp4/meta/pa_extend.ml
index e8fed87b62..0364230453 100644
--- a/camlp4/meta/pa_extend.ml
+++ b/camlp4/meta/pa_extend.ml
@@ -22,9 +22,9 @@ Pcaml.add_option "-split_ext" (Arg.Set split_ext)
 Pcaml.add_option "-split_gext" (Arg.Set split_ext)
   "Old name for the option -split_ext.";
 
-type loc = (int * int);
+type loc = (Lexing.position * Lexing.position);
 
-type name 'e = { expr : 'e; tvar : string; loc : (int * int) };
+type name 'e = { expr : 'e; tvar : string; loc : loc };
 
 type styp =
   [ STlid of loc and string
@@ -163,7 +163,10 @@ module MetaAction =
       in
       failwith (f ^ ", not impl: " ^ desc)
     ;
-    value loc = (0, 0);
+    value loc =
+        let nowhere =
+          { (Lexing.dummy_pos) with Lexing.pos_lnum = 1; Lexing.pos_cnum = 0 } in
+        (nowhere, nowhere);
     value rec mlist mf =
       fun
       [ [] -> <:expr< [] >>
@@ -179,7 +182,10 @@ module MetaAction =
       [ False -> <:expr< False >>
       | True -> <:expr< True >> ]
     ;
-    value mloc = <:expr< (0, 0) >>;
+    value mloc =
+         <:expr< let nowhere =
+          { (Lexing.dummy_pos) with Lexing.pos_lnum = 1; Lexing.pos_cnum = 0 } in
+           (nowhere, nowhere) >>;
     value rec mexpr =
       fun
       [ MLast.ExAcc loc e1 e2 ->
@@ -355,7 +361,10 @@ value quotify_action psl act =
     (fun e ps ->
        match ps.pattern with
        [ Some <:patt< ($list:pl$) >> ->
-           let loc = (0, 0) in
+           let loc =
+             let nowhere =
+               { (Lexing.dummy_pos) with Lexing.pos_lnum = 1; Lexing.pos_cnum = 0 } in
+               (nowhere, nowhere) in
            let pname = pname_of_ptuple pl in
            let (pl1, el1) =
              let (l, _) =
@@ -453,7 +462,7 @@ value text_of_action loc psl rtvar act tvar =
     [ Some act -> if quotify.val then quotify_action psl act else act
     | None -> <:expr< () >> ]
   in
-  let e = <:expr< fun [ ($locid$ : (int * int)) -> ($act$ : '$rtvar$) ] >> in
+  let e = <:expr< fun [ ($locid$ : (Lexing.position * Lexing.position)) -> ($act$ : '$rtvar$) ] >> in
   let txt =
     List.fold_left
       (fun txt ps ->
@@ -724,6 +733,8 @@ value text_of_functorial_extend loc gmod gl el =
   let_in_of_extend loc gmod True gl el args
 ;
 
+value zero_loc = {(Lexing.dummy_pos) with Lexing.pos_cnum = 0};
+
 open Pcaml;
 value symbol = Grammar.Entry.create gram "symbol";
 value semi_sep =
@@ -899,13 +910,13 @@ EXTEND
   string:
     [ [ s = STRING -> <:expr< $str:s$ >>
       | i = ANTIQUOT ->
-          let shift = fst loc + String.length "$" in
+          let shift = Reloc.shift_pos (String.length "$") (fst loc) in
           let e =
             try Grammar.Entry.parse Pcaml.expr_eoi (Stream.of_string i) with
             [ Exc_located (bp, ep) exc ->
-                raise_with_loc (shift + bp, shift + ep) exc ]
+                raise_with_loc (Reloc.adjust_loc shift (bp,ep)) exc ]
           in
-          Pcaml.expr_reloc (fun (bp, ep) -> (shift + bp, shift + ep)) 0 e ] ]
+          Pcaml.expr_reloc (fun (bp, ep) -> (Reloc.adjust_loc shift (bp,ep))) zero_loc e ] ]
   ;
 END;
 
diff --git a/camlp4/meta/pa_macro.ml b/camlp4/meta/pa_macro.ml
index 406a3bd622..b495997e2c 100644
--- a/camlp4/meta/pa_macro.ml
+++ b/camlp4/meta/pa_macro.ml
@@ -64,7 +64,10 @@ value defined = ref [];
 
 value is_defined i = List.mem_assoc i defined.val;
 
-value loc = (0, 0);
+value loc =
+    let nowhere =
+      { (Lexing.dummy_pos) with Lexing.pos_lnum = 1; Lexing.pos_cnum = 0 } in
+    (nowhere, nowhere);
 
 value subst mloc env =
   loop where rec loop =
@@ -119,12 +122,12 @@ value define eo x =
     [ Some ([], e) ->
         EXTEND
           expr: LEVEL "simple"
-            [ [ UIDENT $x$ -> Pcaml.expr_reloc (fun _ -> loc) 0 e ] ]
+            [ [ UIDENT $x$ -> Pcaml.expr_reloc (fun _ -> loc) (fst loc) e ] ]
           ;
           patt: LEVEL "simple"
             [ [ UIDENT $x$ ->
                   let p = substp loc [] e in
-                  Pcaml.patt_reloc (fun _ -> loc) 0 p ] ]
+                  Pcaml.patt_reloc (fun _ -> loc) (fst loc) p ] ]
           ;
         END
     | Some (sl, e) ->
@@ -139,7 +142,7 @@ value define eo x =
                   if List.length el = List.length sl then
                     let env = List.combine sl el in
                     let e = subst loc env e in
-                    Pcaml.expr_reloc (fun _ -> loc) 0 e
+                    Pcaml.expr_reloc (fun _ -> loc) (fst loc) e
                   else
                     incorrect_number loc el sl ] ]
           ;
@@ -153,7 +156,7 @@ value define eo x =
                   if List.length pl = List.length sl then
                     let env = List.combine sl pl in
                     let p = substp loc env e in
-                    Pcaml.patt_reloc (fun _ -> loc) 0 p
+                    Pcaml.patt_reloc (fun _ -> loc) (fst loc) p
                   else
                     incorrect_number loc pl sl ] ]
           ;
@@ -228,8 +231,8 @@ EXTEND
   expr: LEVEL "simple"
     [ [ LIDENT "__FILE__" -> <:expr< $str:Pcaml.input_file.val$ >>
       | LIDENT "__LOCATION__" ->
-          let bp = string_of_int (fst loc) in
-          let ep = string_of_int (snd loc) in
+          let bp = string_of_int ((fst loc).Lexing.pos_cnum) in
+          let ep = string_of_int ((snd loc).Lexing.pos_cnum) in
           <:expr< ($int:bp$, $int:ep$) >> ] ]
   ;
   patt:
diff --git a/camlp4/meta/pa_r.ml b/camlp4/meta/pa_r.ml
index dd6b499ac5..14954cdde9 100644
--- a/camlp4/meta/pa_r.ml
+++ b/camlp4/meta/pa_r.ml
@@ -323,7 +323,10 @@ EXTEND
         "do"; "{"; seq = sequence; "}" ->
           <:expr< for $i$ = $e1$ $to:df$ $e2$ do { $list:seq$ } >>
       | "while"; e = SELF; "do"; "{"; seq = sequence; "}" ->
-          <:expr< while $e$ do { $list:seq$ } >> ]
+          <:expr< while $e$ do { $list:seq$ } >>
+      | "object"; cspo = OPT class_self_patt; cf = class_structure; "end" ->
+          (* <:expr< object $opt:cspo$ $list:cf$ end >> *)
+          MLast.ExObj loc cspo cf ]
     | "where"
       [ e = SELF; "where"; rf = OPT "rec"; lb = let_binding ->
           <:expr< let $opt:o2b rf$ $list:[lb]$ in $e$ >> ]
@@ -392,9 +395,8 @@ EXTEND
           mklistexp loc last el
       | "[|"; el = LIST0 expr SEP ";"; "|]" -> <:expr< [| $list:el$ |] >>
       | "{"; lel = LIST1 label_expr SEP ";"; "}" -> <:expr< { $list:lel$ } >>
-      | "{"; "("; e = SELF; ")"; "with"; lel = LIST1 label_expr SEP ";";
-        "}" ->
-          <:expr< { ($e$) with $list:lel$ } >>
+      | "{"; "("; e = SELF; ")"; "with"; lel = LIST1 label_expr SEP ";"; "}"
+        -> <:expr< { ($e$) with $list:lel$ } >>
       | "("; ")" -> <:expr< () >>
       | "("; e = SELF; ":"; t = ctyp; ")" -> <:expr< ($e$ : $t$) >>
       | "("; e = SELF; ","; el = LIST1 expr SEP ","; ")" ->
@@ -735,8 +737,14 @@ EXTEND
   ;
   ctyp: LEVEL "simple"
     [ [ "#"; id = class_longident -> <:ctyp< # $list:id$ >>
-      | "<"; ml = LIST0 field SEP ";"; v = OPT ".."; ">" ->
-          <:ctyp< < $list:ml$ $opt:o2b v$ > >> ] ]
+      | "<"; (ml, v) = meth_list; ">" -> <:ctyp< < $list:ml$ $opt:v$ > >>
+      | "<"; ">" -> <:ctyp< < > >> ] ]
+  ;
+  meth_list:
+    [ [ f = field; ";"; (ml, v) = SELF -> ([f :: ml], v)
+      | f = field; ";" -> ([f], False)
+      | f = field -> ([f], False)
+      | ".." -> ([], True) ] ]
   ;
   field:
     [ [ lab = LIDENT; ":"; t = ctyp -> (lab, t) ] ]
@@ -760,6 +768,10 @@ EXTEND
       | "["; "<"; rfl = row_field_list; "]" ->
           <:ctyp< [ < $list:rfl$ ] >>
       | "["; "<"; rfl = row_field_list; ">"; ntl = LIST1 name_tag; "]" ->
+          <:ctyp< [ < $list:rfl$ > $list:ntl$ ] >>
+      | "[<"; rfl = row_field_list; "]" ->
+          <:ctyp< [ < $list:rfl$ ] >>
+      | "[<"; rfl = row_field_list; ">"; ntl = LIST1 name_tag; "]" ->
           <:ctyp< [ < $list:rfl$ > $list:ntl$ ] >> ] ]
   ;
   row_field_list:
@@ -901,10 +913,11 @@ EXTEND
           let x =
             try
               let i = String.index x ':' in
-              (int_of_string (String.sub x 0 i),
+              ({ (Lexing.dummy_pos) with Lexing.pos_cnum = int_of_string (String.sub x 0 i) }
+                 ,
                String.sub x (i + 1) (String.length x - i - 1))
             with
-            [ Not_found | Failure _ -> (0, x) ]
+            [ Not_found | Failure _ -> ({(Lexing.dummy_pos) with Lexing.pos_cnum = 0}, x) ]
           in
           Pcaml.handle_expr_locate loc x
       | x = QUOTATION ->
@@ -923,10 +936,11 @@ EXTEND
           let x =
             try
               let i = String.index x ':' in
-              (int_of_string (String.sub x 0 i),
+              ({(Lexing.dummy_pos) with Lexing.pos_cnum = int_of_string (String.sub x 0 i)}
+                 ,
                String.sub x (i + 1) (String.length x - i - 1))
             with
-            [ Not_found | Failure _ -> (0, x) ]
+            [ Not_found | Failure _ -> ({(Lexing.dummy_pos) with Lexing.pos_cnum = 0}, x) ]
           in
           Pcaml.handle_patt_locate loc x
       | x = QUOTATION ->
diff --git a/camlp4/meta/q_MLast.ml b/camlp4/meta/q_MLast.ml
index c10ad7980c..2c79b43d28 100644
--- a/camlp4/meta/q_MLast.ml
+++ b/camlp4/meta/q_MLast.ml
@@ -30,7 +30,10 @@ module Qast =
       | Loc
       | Antiquot of MLast.loc and string ]
     ;
-    value loc = (0, 0);
+    value loc =
+        let nowhere =
+          {(Lexing.dummy_pos) with Lexing.pos_lnum = 1; Lexing.pos_cnum = 0 } in
+          (nowhere,nowhere);
     value rec to_expr =
       fun
       [ Node n al ->
@@ -56,7 +59,7 @@ module Qast =
           let e =
             try Grammar.Entry.parse Pcaml.expr_eoi (Stream.of_string s) with
             [ Stdpp.Exc_located (bp, ep) exc ->
-                raise (Stdpp.Exc_located (fst loc + bp, fst loc + ep) exc) ]
+              raise (Stdpp.Exc_located (Reloc.adjust_loc (fst loc) (bp,ep)) exc) ]
           in
           <:expr< $anti:e$ >> ]
     and to_expr_label (l, a) = (<:patt< MLast.$lid:l$ >>, to_expr a);
@@ -83,7 +86,7 @@ module Qast =
           let p =
             try Grammar.Entry.parse Pcaml.patt_eoi (Stream.of_string s) with
             [ Stdpp.Exc_located (bp, ep) exc ->
-                raise (Stdpp.Exc_located (fst loc + bp, fst loc + ep) exc) ]
+                raise (Stdpp.Exc_located (Reloc.adjust_loc (fst loc) (bp, ep)) exc) ]
           in
           <:patt< $anti:p$ >> ]
     and to_patt_label (l, a) = (<:patt< MLast.$lid:l$ >>, to_patt a);
@@ -95,7 +98,7 @@ value antiquot k (bp, ep) x =
     if k = "" then String.length "$"
     else String.length "$" + String.length k + String.length ":"
   in
-  Qast.Antiquot (shift + bp, shift + ep) x
+  Qast.Antiquot (Reloc.shift_pos shift bp, Reloc.shift_pos (-1) ep) x
 ;
 
 value sig_item = Grammar.Entry.create gram "signature item";
@@ -123,6 +126,9 @@ value a_opt = Grammar.Entry.create gram "a_opt";
 value a_UIDENT = Grammar.Entry.create gram "a_UIDENT";
 value a_LIDENT = Grammar.Entry.create gram "a_LIDENT";
 value a_INT = Grammar.Entry.create gram "a_INT";
+value a_INT32 = Grammar.Entry.create gram "a_INT32";
+value a_INT64 = Grammar.Entry.create gram "a_INT64";
+value a_NATIVEINT = Grammar.Entry.create gram "a__NATIVEINT";
 value a_FLOAT = Grammar.Entry.create gram "a_FLOAT";
 value a_STRING = Grammar.Entry.create gram "a_STRING";
 value a_CHAR = Grammar.Entry.create gram "a_CHAR";
@@ -254,7 +260,7 @@ value not_yet_warned_variant = ref True;
 value warn_variant _ =
   if not_yet_warned_variant.val then do {
     not_yet_warned_variant.val := False;
-    Pcaml.warning.val (0, 1)
+    Pcaml.warning.val (Lexing.dummy_pos, Reloc.shift_pos 1 Lexing.dummy_pos)
       (Printf.sprintf
          "use of syntax of variants types deprecated since version 3.05");
   }
@@ -265,7 +271,7 @@ value not_yet_warned_seq = ref True;
 value warn_sequence _ =
   if not_yet_warned_seq.val then do {
     not_yet_warned_seq.val := False;
-    Pcaml.warning.val (0, 1)
+    Pcaml.warning.val (Lexing.dummy_pos, Reloc.shift_pos 1 Lexing.dummy_pos)
       (Printf.sprintf
          "use of syntax of sequences deprecated since version 3.01.1");
   }
@@ -623,6 +629,9 @@ EXTEND
             [Qast.Loc; Qast.Node "ExLid" [Qast.Loc; Qast.Str "~-."]; e] ]
     | "simple"
       [ s = a_INT -> Qast.Node "ExInt" [Qast.Loc; s]
+      | s = a_INT32 -> Qast.Node  "ExInt32" [Qast.Loc; s]
+      | s = a_INT64 -> Qast.Node  "ExInt64" [Qast.Loc; s]
+      | s = a_NATIVEINT -> Qast.Node  "ExNativeInt" [Qast.Loc; s]
       | s = a_FLOAT -> Qast.Node "ExFlo" [Qast.Loc; s]
       | s = a_STRING -> Qast.Node "ExStr" [Qast.Loc; s]
       | s = a_CHAR -> Qast.Node "ExChr" [Qast.Loc; s]
@@ -712,10 +721,16 @@ EXTEND
       [ s = a_LIDENT -> Qast.Node "PaLid" [Qast.Loc; s]
       | s = a_UIDENT -> Qast.Node "PaUid" [Qast.Loc; s]
       | s = a_INT -> Qast.Node "PaInt" [Qast.Loc; s]
+      | s = a_INT32 -> Qast.Node  "PaInt32" [Qast.Loc; s]
+      | s = a_INT64 -> Qast.Node  "PaInt64" [Qast.Loc; s]
+      | s = a_NATIVEINT -> Qast.Node  "PaNativeInt" [Qast.Loc; s]
       | s = a_FLOAT -> Qast.Node "PaFlo" [Qast.Loc; s]
       | s = a_STRING -> Qast.Node "PaStr" [Qast.Loc; s]
       | s = a_CHAR -> Qast.Node "PaChr" [Qast.Loc; s]
       | "-"; s = a_INT -> mkuminpat Qast.Loc (Qast.Str "-") (Qast.Bool True) s
+      | "-"; s = a_INT32 -> mkuminpat Qast.Loc (Qast.Str "-") (Qast.Bool True) s
+      | "-"; s = a_INT64 -> mkuminpat Qast.Loc (Qast.Str "-") (Qast.Bool True) s
+      | "-"; s = a_NATIVEINT -> mkuminpat Qast.Loc (Qast.Str "-") (Qast.Bool True) s
       | "-"; s = a_FLOAT ->
           mkuminpat Qast.Loc (Qast.Str "-") (Qast.Bool False) s
       | "["; "]" -> Qast.Node "PaUid" [Qast.Loc; Qast.Str "[]"]
@@ -1027,6 +1042,13 @@ EXTEND
              Qast.Option (Some (Qast.Option (Some (Qast.List []))))]
       | "["; "<"; rfl = row_field_list; ">"; ntl = SLIST1 name_tag; "]" ->
           Qast.Node "TyVrn"
+            [Qast.Loc; rfl; Qast.Option (Some (Qast.Option (Some ntl)))]
+      | "[<"; rfl = row_field_list; "]" ->
+          Qast.Node "TyVrn"
+            [Qast.Loc; rfl;
+             Qast.Option (Some (Qast.Option (Some (Qast.List []))))]
+      | "[<"; rfl = row_field_list; ">"; ntl = SLIST1 name_tag; "]" ->
+          Qast.Node "TyVrn"
             [Qast.Loc; rfl; Qast.Option (Some (Qast.Option (Some ntl)))] ] ]
   ;
   row_field_list:
@@ -1332,6 +1354,21 @@ EXTEND
       | a = ANTIQUOT -> antiquot "" loc a
       | s = INT -> Qast.Str s ] ]
   ;
+  a_INT32:
+    [ [ a = ANTIQUOT "int32" -> antiquot "int32" loc a
+      | a = ANTIQUOT -> antiquot "" loc a
+      | s = INT32 -> Qast.Str s ] ]
+  ;
+  a_INT64:
+    [ [ a = ANTIQUOT "int64" -> antiquot "int64" loc a
+      | a = ANTIQUOT -> antiquot "" loc a
+      | s = INT64 -> Qast.Str s ] ]
+  ;
+  a_NATIVEINT:
+    [ [ a = ANTIQUOT "nativeint" -> antiquot "nativeint" loc a
+      | a = ANTIQUOT -> antiquot "" loc a
+      | s = NATIVEINT -> Qast.Str s ] ]
+  ;
   a_FLOAT:
     [ [ a = ANTIQUOT "flo" -> antiquot "flo" loc a
       | a = ANTIQUOT -> antiquot "" loc a
diff --git a/camlp4/ocaml_src/camlp4/.depend b/camlp4/ocaml_src/camlp4/.depend
index bf82065403..63efcf4310 100644
--- a/camlp4/ocaml_src/camlp4/.depend
+++ b/camlp4/ocaml_src/camlp4/.depend
@@ -7,10 +7,14 @@ argl.cmo: ast2pt.cmi mLast.cmi ../odyl/odyl_main.cmi pcaml.cmi
 argl.cmx: ast2pt.cmx mLast.cmi ../odyl/odyl_main.cmx pcaml.cmx 
 ast2pt.cmo: $(OTOP)/parsing/asttypes.cmi $(OTOP)/parsing/location.cmi \
     $(OTOP)/parsing/longident.cmi mLast.cmi $(OTOP)/parsing/parsetree.cmi \
-    ast2pt.cmi 
+    pcaml.cmi ast2pt.cmi 
 ast2pt.cmx: $(OTOP)/parsing/asttypes.cmi $(OTOP)/parsing/location.cmx \
     $(OTOP)/parsing/longident.cmx mLast.cmi $(OTOP)/parsing/parsetree.cmi \
-    ast2pt.cmi 
+    pcaml.cmx ast2pt.cmi 
+pcaml.cmo: mLast.cmi quotation.cmi reloc.cmi spretty.cmi pcaml.cmi 
+pcaml.cmx: mLast.cmi quotation.cmx reloc.cmx spretty.cmx pcaml.cmi 
+crc.cmo: $(OTOP)/otherlibs/dynlink/dynlink.cmi 
+crc.cmx: $(OTOP)/otherlibs/dynlink/dynlink.cmx 
 pcaml.cmo: ast2pt.cmi mLast.cmi quotation.cmi reloc.cmi spretty.cmi pcaml.cmi 
 pcaml.cmx: ast2pt.cmx mLast.cmi quotation.cmx reloc.cmx spretty.cmx pcaml.cmi 
 quotation.cmo: mLast.cmi quotation.cmi 
diff --git a/camlp4/ocaml_src/camlp4/Makefile b/camlp4/ocaml_src/camlp4/Makefile
index 0e5d05762d..c60f6d1e11 100644
--- a/camlp4/ocaml_src/camlp4/Makefile
+++ b/camlp4/ocaml_src/camlp4/Makefile
@@ -9,8 +9,8 @@ OCAMLCFLAGS= $(INCLUDES) -warn-error A $(INCLUDES)
 LINKFLAGS=$(INCLUDES)
 INTERFACES=-I $(OLIBDIR) Arg Array ArrayLabels Buffer Callback CamlinternalOO Char Complex Digest Filename Format Gc Genlex Hashtbl Int32 Int64 Lazy Lexing List ListLabels Map Marshal MoreLabels Nativeint Obj Oo Parsing Pervasives Printexc Printf Queue Random Scanf Set Sort Stack StdLabels Stream String StringLabels Sys Weak -I ../../boot Extfold Extfun Fstream Gramext Grammar Plexer Stdpp Token -I $(OTOP)/utils Config Warnings -I $(OTOP)/parsing Asttypes Location Longident Parsetree -I . Ast2pt MLast Pcaml Quotation Spretty
 CAMLP4_INTF=$(OTOP)/utils/config.cmi $(OTOP)/utils/warnings.cmi $(OTOP)/parsing/asttypes.cmi $(OTOP)/parsing/location.cmi $(OTOP)/parsing/longident.cmi $(OTOP)/parsing/parsetree.cmi ast2pt.cmi mLast.cmi pcaml.cmi spretty.cmi quotation.cmi
-CAMLP4_OBJS=../../boot/stdpp.cmo ../../boot/token.cmo ../../boot/plexer.cmo ../../boot/gramext.cmo ../../boot/grammar.cmo ../../boot/extfold.cmo ../../boot/extfun.cmo ../../boot/fstream.cmo $(OTOP)/utils/config.cmo quotation.cmo ast2pt.cmo spretty.cmo reloc.cmo pcaml.cmo argl.cmo
-CAMLP4_XOBJS=../lib/stdpp.cmx ../lib/token.cmx ../lib/plexer.cmx ../lib/gramext.cmx ../lib/grammar.cmx ../lib/extfold.cmx ../lib/extfun.cmx ../lib/fstream.cmx $(OTOP)/utils/config.cmx quotation.cmx ast2pt.cmx spretty.cmx reloc.cmx pcaml.cmx argl.cmx
+CAMLP4_OBJS=../../boot/stdpp.cmo ../../boot/token.cmo ../../boot/plexer.cmo ../../boot/gramext.cmo ../../boot/grammar.cmo ../../boot/extfold.cmo ../../boot/extfun.cmo ../../boot/fstream.cmo $(OTOP)/utils/config.cmo quotation.cmo spretty.cmo reloc.cmo pcaml.cmo ast2pt.cmo argl.cmo
+CAMLP4_XOBJS=../lib/stdpp.cmx ../lib/token.cmx ../lib/plexer.cmx ../lib/gramext.cmx ../lib/grammar.cmx ../lib/extfold.cmx ../lib/extfun.cmx ../lib/fstream.cmx $(OTOP)/utils/config.cmx quotation.cmx spretty.cmx reloc.cmx pcaml.cmx ast2pt.cmx argl.cmx
 OBJS=../odyl/odyl.cma camlp4.cma
 CAMLP4M=
 
@@ -22,7 +22,7 @@ opt: $(OBJS:.cma=.cmxa)
 optp4: $(CAMLP4OPT)
 
 $(CAMLP4): $(OBJS) ../odyl/odyl.cmo
-	$(OCAMLC) $(OBJS) $(CAMLP4M) ../odyl/odyl.cmo -linkall -o $(CAMLP4)
+	$(OCAMLC) -g $(OBJS) $(CAMLP4M) ../odyl/odyl.cmo -linkall -o $(CAMLP4)
 
 $(CAMLP4OPT): $(OBJS:.cma=.cmxa) ../odyl/odyl.cmx
 	$(OCAMLOPT) $(OBJS:.cma=.cmxa) $(CAMLP4M) ../odyl/odyl.cmx -linkall -o $(CAMLP4OPT)
diff --git a/camlp4/ocaml_src/camlp4/argl.ml b/camlp4/ocaml_src/camlp4/argl.ml
index 0f6ac98ced..ced893b1ad 100644
--- a/camlp4/ocaml_src/camlp4/argl.ml
+++ b/camlp4/ocaml_src/camlp4/argl.ml
@@ -128,7 +128,9 @@ let print_location loc =
   if !(Pcaml.input_file) <> "-" then
     let (fname, line, bp, ep) = Stdpp.line_of_loc !(Pcaml.input_file) loc in
     eprintf loc_fmt !(Pcaml.input_file) line bp ep
-  else eprintf "At location %d-%d\n" (fst loc) (snd loc)
+  else
+    eprintf "At location %d-%d\n" (fst loc).Lexing.pos_cnum
+      (snd loc).Lexing.pos_cnum
 ;;
 
 let print_warning loc s = print_location loc; eprintf "%s\n" s;;
@@ -215,6 +217,10 @@ let file_kind_of_name name =
   else raise (Arg.Bad ("don't know what to do with " ^ name))
 ;;
 
+let print_version_string () =
+  print_string Pcaml.version; print_newline (); exit 0
+;;
+
 let print_version () =
   eprintf "Camlp4 version %s\n" Pcaml.version; flush stderr; exit 0
 ;;
@@ -291,14 +297,7 @@ let print_usage_list l =
 
 let usage ini_sl ext_sl =
   eprintf "\
-Usage: camlp4 [load-options] [--] [other-options]
-Load options:
-  -I directory  Add directory in search patch for object files.
-  -where        Print camlp4 library directory and exit.
-  -nolib        No automatic search for object files in library directory.
-  <object-file> Load this file in Camlp4 core.
-Other options:
-  <file>        Parse this file.\n";
+Usage: camlp4 [load-options] [--] [other-options]Load options:  -I directory  Add directory in search patch for object files.  -where        Print camlp4 library directory and exit.  -nolib        No automatic search for object files in library directory.  <object-file> Load this file in Camlp4 core.Other options:  <file>        Parse this file.\n";
   print_usage_list ini_sl;
   begin
     let rec loop =
@@ -318,9 +317,7 @@ Other options:
 
 let warn_noassert () =
   eprintf "\
-camlp4 warning: option -noassert is obsolete
-You should give the -noassert option to the ocaml compiler instead.
-"
+camlp4 warning: option -noassert is obsoleteYou should give the -noassert option to the ocaml compiler instead."
 ;;
 
 let initial_spec_list =
@@ -340,7 +337,9 @@ let initial_spec_list =
    "<file> Dump quotation expander result in case of syntax error.";
    "-o", Arg.String (fun x -> Pcaml.output_file := Some x),
    "<file> Output on <file> instead of standard output.";
-   "-v", Arg.Unit print_version, "Print Camlp4 version and exit."]
+   "-v", Arg.Unit print_version, "Print Camlp4 version and exit.";
+   "-version", Arg.Unit print_version_string,
+   "Print Camlp4 version number and exit."]
 ;;
 
 let anon_fun x = Pcaml.input_file := x; file_kind := file_kind_of_name x;;
diff --git a/camlp4/ocaml_src/camlp4/ast2pt.ml b/camlp4/ocaml_src/camlp4/ast2pt.ml
index b243109b73..786075527c 100644
--- a/camlp4/ocaml_src/camlp4/ast2pt.ml
+++ b/camlp4/ocaml_src/camlp4/ast2pt.ml
@@ -19,7 +19,7 @@ open Longident;;
 open Asttypes;;
 
 let fast = ref false;;
-let no_constructors_arity = ref false;;
+let no_constructors_arity = Pcaml.no_constructors_arity;;
 
 let get_tag x =
   if Obj.is_block (Obj.repr x) then Obj.tag (Obj.repr x) else Obj.magic x
@@ -41,17 +41,23 @@ let glob_fname = ref "";;
 
 let mkloc (bp, ep) =
   let loc_at n =
-    {Lexing.pos_fname = !glob_fname; Lexing.pos_lnum = 1; Lexing.pos_bol = 0;
-     Lexing.pos_cnum = n}
+    {n with
+      Lexing.pos_fname =
+        if n.Lexing.pos_fname = "" then
+          if !glob_fname = "" then !(Pcaml.input_file) else !glob_fname
+        else n.Lexing.pos_fname}
   in
   {Location.loc_start = loc_at bp; Location.loc_end = loc_at ep;
-   Location.loc_ghost = false}
+   Location.loc_ghost = bp.Lexing.pos_cnum = 0 && ep.Lexing.pos_cnum = 0}
 ;;
 
 let mkghloc (bp, ep) =
   let loc_at n =
-    {Lexing.pos_fname = ""; Lexing.pos_lnum = 1; Lexing.pos_bol = 0;
-     Lexing.pos_cnum = n}
+    {n with
+      Lexing.pos_fname =
+        if n.Lexing.pos_fname = "" then
+          if !glob_fname = "" then !(Pcaml.input_file) else !glob_fname
+        else n.Lexing.pos_fname}
   in
   {Location.loc_start = loc_at bp; Location.loc_end = loc_at ep;
    Location.loc_ghost = true}
@@ -125,19 +131,31 @@ let rec ctyp_fa al =
   | f -> f, al
 ;;
 
-let rec ctyp_long_id =
-  function
+let rec ctyp_long_id_prefix t =
+  match t with
     TyAcc (_, m, TyLid (_, s)) ->
-      let (is_cls, li) = ctyp_long_id m in is_cls, ldot li s
+      error (loc_of_ctyp t) "invalid module expression"
   | TyAcc (_, m, TyUid (_, s)) ->
-      let (is_cls, li) = ctyp_long_id m in is_cls, ldot li s
+      let (is_cls, li) = ctyp_long_id_prefix m in is_cls, ldot li s
   | TyApp (_, m1, m2) ->
-      let (is_cls, li1) = ctyp_long_id m1 in
-      let (_, li2) = ctyp_long_id m2 in is_cls, Lapply (li1, li2)
+      let (is_cls, li1) = ctyp_long_id_prefix m1 in
+      let (_, li2) = ctyp_long_id_prefix m2 in is_cls, Lapply (li1, li2)
   | TyUid (_, s) -> false, lident s
+  | TyLid (_, s) -> error (loc_of_ctyp t) "invalid module expression"
+  | t -> error (loc_of_ctyp t) "invalid module expression"
+;;
+
+let ctyp_long_id t =
+  match t with
+    TyAcc (_, m, TyLid (_, s)) ->
+      let (is_cls, li) = ctyp_long_id_prefix m in is_cls, ldot li s
+  | TyAcc (_, m, (TyUid (_, s) as t)) ->
+      error (loc_of_ctyp t) "invalid type name"
+  | TyApp (_, m1, m2) -> error (loc_of_ctyp t) "invalid type name"
+  | TyUid (_, s) -> error (loc_of_ctyp t) "invalid type name"
   | TyLid (_, s) -> false, lident s
   | TyCls (loc, sl) -> true, long_id_of_string_list loc sl
-  | t -> error (loc_of_ctyp t) "incorrect type"
+  | t -> error (loc_of_ctyp t) "invalid type"
 ;;
 
 let rec ctyp =
@@ -151,7 +169,7 @@ let rec ctyp =
         match t1, t2 with
           t, TyQuo (_, s) -> t, s
         | TyQuo (_, s), t -> t, s
-        | _ -> error loc "incorrect alias type"
+        | _ -> error loc "invalid alias type"
       in
       mktyp loc (Ptyp_alias (ctyp t, i))
   | TyAny loc -> mktyp loc Ptyp_any
@@ -178,7 +196,7 @@ let rec ctyp =
   | TyRec (loc, _, _) -> error loc "record type not allowed here"
   | TySum (loc, _, _) -> error loc "sum type not allowed here"
   | TyTup (loc, tl) -> mktyp loc (Ptyp_tuple (List.map ctyp tl))
-  | TyUid (loc, s) -> mktyp loc (Ptyp_constr (lident s, []))
+  | TyUid (loc, s) as t -> error (loc_of_ctyp t) "invalid type"
   | TyVrn (loc, catl, ool) ->
       let catl =
         List.map
@@ -391,7 +409,7 @@ let rec patt =
         match p1, p2 with
           p, PaLid (_, s) -> p, s
         | PaLid (_, s), p -> p, s
-        | _ -> error loc "incorrect alias pattern"
+        | _ -> error loc "invalid alias pattern"
       in
       mkpat loc (Ppat_alias (patt p, i))
   | PaAnt (_, p) -> patt p
@@ -623,6 +641,14 @@ let rec expr =
       mkexp loc (Pexp_letmodule (i, module_expr me, expr e))
   | ExMat (loc, e, pel) -> mkexp loc (Pexp_match (expr e, List.map mkpwe pel))
   | ExNew (loc, id) -> mkexp loc (Pexp_new (long_id_of_string_list loc id))
+  | ExObj (loc, po, cfl) ->
+      let p =
+        match po with
+          Some p -> p
+        | None -> PaAny loc
+      in
+      let cil = List.fold_right class_str_item cfl [] in
+      mkexp loc (Pexp_object (patt p, cil))
   | ExOlb (loc, _, _) -> error loc "labeled expression not allowed here"
   | ExOvr (loc, iel) -> mkexp loc (Pexp_override (List.map mkideexp iel))
   | ExRec (loc, lel, eo) ->
diff --git a/camlp4/ocaml_src/camlp4/ast2pt.mli b/camlp4/ocaml_src/camlp4/ast2pt.mli
index d64fb6e370..c6aeab292b 100644
--- a/camlp4/ocaml_src/camlp4/ast2pt.mli
+++ b/camlp4/ocaml_src/camlp4/ast2pt.mli
@@ -14,8 +14,8 @@
 
 val fast : bool ref;;
 val no_constructors_arity : bool ref;;
-val mkloc : int * int -> Location.t;;
-val long_id_of_string_list : int * int -> string list -> Longident.t;;
+val mkloc : MLast.loc -> Location.t;;
+val long_id_of_string_list : MLast.loc -> string list -> Longident.t;;
 
 val str_item : MLast.str_item -> Parsetree.structure -> Parsetree.structure;;
 val interf : MLast.sig_item list -> Parsetree.signature;;
diff --git a/camlp4/ocaml_src/camlp4/mLast.mli b/camlp4/ocaml_src/camlp4/mLast.mli
index 54a66b9c65..5dc63a296e 100644
--- a/camlp4/ocaml_src/camlp4/mLast.mli
+++ b/camlp4/ocaml_src/camlp4/mLast.mli
@@ -19,7 +19,7 @@
    these values in concrete syntax (see the Camlp4 documentation).
    See also the file q_MLast.ml in Camlp4 sources. *)
 
-type loc = int * int;;
+type loc = Lexing.position * Lexing.position;;
 
 type ctyp =
     TyAcc of loc * ctyp * ctyp
@@ -104,6 +104,7 @@ and expr =
   | ExLmd of loc * string * module_expr * expr
   | ExMat of loc * expr * (patt * expr option * expr) list
   | ExNew of loc * string list
+  | ExObj of loc * patt option * class_str_item list
   | ExOlb of loc * string * expr option
   | ExOvr of loc * (string * expr) list
   | ExRec of loc * (patt * expr) list * expr option
diff --git a/camlp4/ocaml_src/camlp4/pcaml.ml b/camlp4/ocaml_src/camlp4/pcaml.ml
index 7258fa070e..7d29cdad8b 100644
--- a/camlp4/ocaml_src/camlp4/pcaml.ml
+++ b/camlp4/ocaml_src/camlp4/pcaml.ml
@@ -20,7 +20,7 @@ let gram =
   Grammar.gcreate
     {Token.tok_func = (fun _ -> failwith "no loaded parsing module");
      Token.tok_using = (fun _ -> ()); Token.tok_removing = (fun _ -> ());
-     Token.tok_match = (fun _ -> raise (Match_failure ("pcaml.ml", 23, 23)));
+     Token.tok_match = (fun _ -> raise (Match_failure ("", 23, 23)));
      Token.tok_text = (fun _ -> ""); Token.tok_comm = None}
 ;;
 
@@ -58,7 +58,11 @@ let input_file = ref "";;
 let output_file = ref None;;
 
 let warning_default_function (bp, ep) txt =
-  Printf.eprintf "<W> loc %d %d: %s\n" bp ep txt; flush stderr
+  let c1 = bp.Lexing.pos_cnum - bp.Lexing.pos_bol in
+  let c2 = ep.Lexing.pos_cnum - bp.Lexing.pos_bol in
+  Printf.eprintf "<W> File \"%s\", line %d, chars %d-%d: %s\n"
+    bp.Lexing.pos_fname bp.Lexing.pos_lnum c1 c2 txt;
+  flush stderr
 ;;
 
 let warning = ref warning_default_function;;
@@ -78,7 +82,7 @@ let quotation_dump_file = ref (None : string option);;
 type err_ctx =
     Finding
   | Expanding
-  | ParsingResult of (int * int) * string
+  | ParsingResult of MLast.loc * string
   | Locating
 ;;
 exception Qerror of string * err_ctx * exn;;
@@ -86,14 +90,16 @@ exception Qerror of string * err_ctx * exn;;
 let expand_quotation loc expander shift name str =
   let new_warning =
     let warn = !warning in
-    fun (bp, ep) txt -> warn (shift + bp, shift + ep) txt
+    fun (bp, ep) txt -> warn (Reloc.adjust_loc shift (bp, ep)) txt
   in
   apply_with_var warning new_warning
     (fun () ->
        try expander str with
-         Stdpp.Exc_located ((p1, p2), exc) ->
+         Stdpp.Exc_located (loc, exc) ->
            let exc1 = Qerror (name, Expanding, exc) in
-           raise (Stdpp.Exc_located ((shift + p1, shift + p2), exc1))
+           raise
+             (Stdpp.Exc_located
+                (Reloc.adjust_loc shift (Reloc.linearize loc), exc1))
        | exc ->
            let exc1 = Qerror (name, Expanding, exc) in
            raise (Stdpp.Exc_located (loc, exc1)))
@@ -103,7 +109,7 @@ let parse_quotation_result entry loc shift name str =
   let cs = Stream.of_string str in
   try Grammar.Entry.parse entry cs with
     Stdpp.Exc_located (iloc, (Qerror (_, Locating, _) as exc)) ->
-      raise (Stdpp.Exc_located ((shift + fst iloc, shift + snd iloc), exc))
+      raise (Stdpp.Exc_located (Reloc.adjust_loc shift iloc, exc))
   | Stdpp.Exc_located (iloc, Qerror (_, Expanding, exc)) ->
       let ctx = ParsingResult (iloc, str) in
       let exc1 = Qerror (name, ctx, exc) in
@@ -116,18 +122,22 @@ let parse_quotation_result entry loc shift name str =
       raise (Stdpp.Exc_located (loc, exc1))
 ;;
 
+let ghostify (bp, ep) =
+  let ghost p = {p with Lexing.pos_cnum = 0} in ghost bp, ghost ep
+;;
+
 let handle_quotation loc proj in_expr entry reloc (name, str) =
   let shift =
     match name with
       "" -> String.length "<<"
     | _ -> String.length "<:" + String.length name + String.length "<"
   in
-  let shift = fst loc + shift in
+  let shift = Reloc.shift_pos shift (fst loc) in
   let expander =
     try Quotation.find name with
       exc ->
         let exc1 = Qerror (name, Finding, exc) in
-        let loc = fst loc, shift in raise (Stdpp.Exc_located (loc, exc1))
+        raise (Stdpp.Exc_located ((fst loc, shift), exc1))
   in
   let ast =
     match expander with
@@ -137,7 +147,13 @@ let handle_quotation loc proj in_expr entry reloc (name, str) =
     | Quotation.ExAst fe_fp ->
         expand_quotation loc (proj fe_fp) shift name str
   in
-  reloc (fun _ -> loc) shift ast
+  reloc
+    (let zero = ref None in
+     fun _ ->
+       match !zero with
+         None -> zero := Some (ghostify loc); loc
+       | Some x -> x)
+    shift ast
 ;;
 
 let parse_locate entry shift str =
@@ -146,12 +162,12 @@ let parse_locate entry shift str =
     Stdpp.Exc_located ((p1, p2), exc) ->
       let ctx = Locating in
       let exc1 = Qerror (Grammar.Entry.name entry, ctx, exc) in
-      raise (Stdpp.Exc_located ((shift + p1, shift + p2), exc1))
+      raise (Stdpp.Exc_located (Reloc.adjust_loc shift (p1, p2), exc1))
 ;;
 
 let handle_locate loc entry ast_f (pos, str) =
   let s = str in
-  let loc = pos, pos + String.length s in
+  let loc = pos, Reloc.shift_pos (String.length s) pos in
   let x = parse_locate entry (fst loc) s in ast_f loc x
 ;;
 
@@ -165,13 +181,15 @@ Grammar.extend
     [[Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e));
       Gramext.Stoken ("EOI", "")],
      Gramext.action
-       (fun _ (x : 'expr) (loc : int * int) -> (x : 'expr_eoi))]];
+       (fun _ (x : 'expr) (loc : Lexing.position * Lexing.position) ->
+          (x : 'expr_eoi))]];
    Grammar.Entry.obj (patt_eoi : 'patt_eoi Grammar.Entry.e), None,
    [None, None,
     [[Gramext.Snterm (Grammar.Entry.obj (patt : 'patt Grammar.Entry.e));
       Gramext.Stoken ("EOI", "")],
      Gramext.action
-       (fun _ (x : 'patt) (loc : int * int) -> (x : 'patt_eoi))]]];;
+       (fun _ (x : 'patt) (loc : Lexing.position * Lexing.position) ->
+          (x : 'patt_eoi))]]];;
 
 let handle_expr_quotation loc x =
   handle_quotation loc fst true expr_eoi Reloc.expr x
@@ -191,13 +209,8 @@ let patt_reloc = Reloc.patt;;
 let rename_id = ref (fun x -> x);;
 
 let find_line (bp, ep) str =
-  let rec find i line col =
-    if i == String.length str then line, 0, col
-    else if i == bp then line, col, col + ep - bp
-    else if str.[i] == '\n' then find (succ i) (succ line) 0
-    else find (succ i) line (succ col)
-  in
-  find 0 1 0
+  bp.Lexing.pos_lnum, bp.Lexing.pos_cnum - bp.Lexing.pos_bol,
+  ep.Lexing.pos_cnum - bp.Lexing.pos_bol
 ;;
 
 let loc_fmt =
@@ -332,7 +345,7 @@ let report_error exn =
   | e -> print_exn exn
 ;;
 
-let no_constructors_arity = Ast2pt.no_constructors_arity;;
+let no_constructors_arity = ref false;;
 (*value no_assert = ref False;*)
 
 let arg_spec_list_ref = ref [];;
@@ -360,48 +373,37 @@ and kont = pretty Stream.t
 ;;
 
 let pr_str_item =
-  {pr_fun = (fun _ -> raise (Match_failure ("pcaml.ml", 385, 30)));
-   pr_levels = []}
+  {pr_fun = (fun _ -> raise (Match_failure ("", 397, 30))); pr_levels = []}
 ;;
 let pr_sig_item =
-  {pr_fun = (fun _ -> raise (Match_failure ("pcaml.ml", 386, 30)));
-   pr_levels = []}
+  {pr_fun = (fun _ -> raise (Match_failure ("", 398, 30))); pr_levels = []}
 ;;
 let pr_module_type =
-  {pr_fun = (fun _ -> raise (Match_failure ("pcaml.ml", 387, 33)));
-   pr_levels = []}
+  {pr_fun = (fun _ -> raise (Match_failure ("", 399, 33))); pr_levels = []}
 ;;
 let pr_module_expr =
-  {pr_fun = (fun _ -> raise (Match_failure ("pcaml.ml", 388, 33)));
-   pr_levels = []}
+  {pr_fun = (fun _ -> raise (Match_failure ("", 400, 33))); pr_levels = []}
 ;;
 let pr_expr =
-  {pr_fun = (fun _ -> raise (Match_failure ("pcaml.ml", 389, 26)));
-   pr_levels = []}
+  {pr_fun = (fun _ -> raise (Match_failure ("", 401, 26))); pr_levels = []}
 ;;
 let pr_patt =
-  {pr_fun = (fun _ -> raise (Match_failure ("pcaml.ml", 390, 26)));
-   pr_levels = []}
+  {pr_fun = (fun _ -> raise (Match_failure ("", 402, 26))); pr_levels = []}
 ;;
 let pr_ctyp =
-  {pr_fun = (fun _ -> raise (Match_failure ("pcaml.ml", 391, 26)));
-   pr_levels = []}
+  {pr_fun = (fun _ -> raise (Match_failure ("", 403, 26))); pr_levels = []}
 ;;
 let pr_class_sig_item =
-  {pr_fun = (fun _ -> raise (Match_failure ("pcaml.ml", 392, 36)));
-   pr_levels = []}
+  {pr_fun = (fun _ -> raise (Match_failure ("", 404, 36))); pr_levels = []}
 ;;
 let pr_class_str_item =
-  {pr_fun = (fun _ -> raise (Match_failure ("pcaml.ml", 393, 36)));
-   pr_levels = []}
+  {pr_fun = (fun _ -> raise (Match_failure ("", 405, 36))); pr_levels = []}
 ;;
 let pr_class_type =
-  {pr_fun = (fun _ -> raise (Match_failure ("pcaml.ml", 394, 32)));
-   pr_levels = []}
+  {pr_fun = (fun _ -> raise (Match_failure ("", 406, 32))); pr_levels = []}
 ;;
 let pr_class_expr =
-  {pr_fun = (fun _ -> raise (Match_failure ("pcaml.ml", 395, 32)));
-   pr_levels = []}
+  {pr_fun = (fun _ -> raise (Match_failure ("", 407, 32))); pr_levels = []}
 ;;
 let pr_expr_fun_args = ref Extfun.empty;;
 
diff --git a/camlp4/ocaml_src/camlp4/pcaml.mli b/camlp4/ocaml_src/camlp4/pcaml.mli
index 8f8eacaf24..24c2256bed 100644
--- a/camlp4/ocaml_src/camlp4/pcaml.mli
+++ b/camlp4/ocaml_src/camlp4/pcaml.mli
@@ -83,13 +83,15 @@ val no_constructors_arity : bool ref;;
 val sync : (char Stream.t -> unit) ref;;
 
 val handle_expr_quotation : MLast.loc -> string * string -> MLast.expr;;
-val handle_expr_locate : MLast.loc -> int * string -> MLast.expr;;
+val handle_expr_locate : MLast.loc -> Lexing.position * string -> MLast.expr;;
 
 val handle_patt_quotation : MLast.loc -> string * string -> MLast.patt;;
-val handle_patt_locate : MLast.loc -> int * string -> MLast.patt;;
+val handle_patt_locate : MLast.loc -> Lexing.position * string -> MLast.patt;;
 
-val expr_reloc : (MLast.loc -> MLast.loc) -> int -> MLast.expr -> MLast.expr;;
-val patt_reloc : (MLast.loc -> MLast.loc) -> int -> MLast.patt -> MLast.patt;;
+val expr_reloc :
+  (MLast.loc -> MLast.loc) -> Lexing.position -> MLast.expr -> MLast.expr;;
+val patt_reloc :
+  (MLast.loc -> MLast.loc) -> Lexing.position -> MLast.patt -> MLast.patt;;
 
 (** To possibly rename identifiers; parsers may call this function
     when generating their identifiers; default = identity *)
@@ -99,7 +101,7 @@ val rename_id : (string -> string) ref;;
 type err_ctx =
     Finding
   | Expanding
-  | ParsingResult of (int * int) * string
+  | ParsingResult of MLast.loc * string
   | Locating
 ;;
 exception Qerror of string * err_ctx * exn;;
@@ -152,7 +154,8 @@ val inter_phrases : string option ref;;
 
 (* for system use *)
 
-val warning : (int * int -> string -> unit) ref;;
+val warning : (MLast.loc -> string -> unit) ref;;
 val expr_eoi : MLast.expr Grammar.Entry.e;;
 val patt_eoi : MLast.patt Grammar.Entry.e;;
 val arg_spec_list : unit -> (string * Arg.spec * string) list;;
+val no_constructors_arity : bool ref;;
diff --git a/camlp4/ocaml_src/camlp4/reloc.ml b/camlp4/ocaml_src/camlp4/reloc.ml
index 980d6ce786..1e22fee939 100644
--- a/camlp4/ocaml_src/camlp4/reloc.ml
+++ b/camlp4/ocaml_src/camlp4/reloc.ml
@@ -63,150 +63,268 @@ let class_infos a floc sh x =
    ciExp = a floc sh x.ciExp}
 ;;
 
+(* Debugging positions and locations *)
+let eprint_pos msg p =
+  Printf.eprintf "%s: fname=%s; lnum=%d; bol=%d; cnum=%d\n%!" msg
+    p.Lexing.pos_fname p.Lexing.pos_lnum p.Lexing.pos_bol p.Lexing.pos_cnum
+;;
+
+let eprint_loc (bp, ep) = eprint_pos "   P1" bp; eprint_pos "   P2" ep;;
+   
+let check_position msg p =
+  let ok =
+    if p.Lexing.pos_lnum < 0 || p.Lexing.pos_bol < 0 ||
+       p.Lexing.pos_cnum < 0 || p.Lexing.pos_cnum < p.Lexing.pos_bol
+    then
+      begin
+        Printf.eprintf "*** Warning: (%s) strange position ***\n" msg;
+        eprint_pos msg p;
+        false
+      end
+    else true
+  in
+  ok, p
+;;
+
+let check_location msg (bp, ep as loc) =
+  let ok =
+    let (ok1, _) = check_position "  From: " bp in
+    let (ok2, _) = check_position "    To: " ep in
+    if not ok1 || not ok2 || bp.Lexing.pos_lnum > ep.Lexing.pos_lnum ||
+       bp.Lexing.pos_bol > ep.Lexing.pos_bol ||
+       bp.Lexing.pos_cnum > ep.Lexing.pos_cnum
+    then
+      begin
+        Printf.eprintf "*** Warning: (%s) strange location ***\n" msg;
+        eprint_loc loc;
+        false
+      end
+    else true
+  in
+  ok, loc
+;;
+
+(* Change a location into linear positions *)
+let linearize (bp, ep) =
+  {bp with Lexing.pos_lnum = 1; Lexing.pos_bol = 0},
+  {ep with Lexing.pos_lnum = 1; Lexing.pos_bol = 0}
+;;
+
+let shift_pos n p = {p with Lexing.pos_cnum = p.Lexing.pos_cnum + n};;
+
+let zero_loc =
+  {(Lexing.dummy_pos) with Lexing.pos_cnum = 0; Lexing.pos_lnum = 0}
+;;
+
+
+let adjust_pos globpos local_pos =
+  {Lexing.pos_fname = globpos.Lexing.pos_fname;
+   Lexing.pos_lnum = globpos.Lexing.pos_lnum + local_pos.Lexing.pos_lnum - 1;
+   Lexing.pos_bol =
+     if local_pos.Lexing.pos_lnum <= 1 then globpos.Lexing.pos_bol
+     else local_pos.Lexing.pos_bol + globpos.Lexing.pos_cnum;
+   Lexing.pos_cnum = local_pos.Lexing.pos_cnum + globpos.Lexing.pos_cnum}
+;;
+
+let adjust_loc gpos (p1, p2) = adjust_pos gpos p1, adjust_pos gpos p2;;
+
+(* Note: in the following, the "let nloc = floc loc in" is necessary
+   in order to force evaluation order: the "floc" function has a side-effect
+   that changes all locations produced but the first one into ghost locations *)
+
 let rec patt floc sh =
   let rec self =
     function
-      PaAcc (loc, x1, x2) -> PaAcc (floc loc, self x1, self x2)
-    | PaAli (loc, x1, x2) -> PaAli (floc loc, self x1, self x2)
+      PaAcc (loc, x1, x2) ->
+        let nloc = floc loc in PaAcc (nloc, self x1, self x2)
+    | PaAli (loc, x1, x2) ->
+        let nloc = floc loc in PaAli (nloc, self x1, self x2)
     | PaAnt (loc, x1) ->
-        patt (fun (p1, p2) -> sh + fst loc + p1, sh + fst loc + p2) 0 x1
-    | PaAny loc -> PaAny (floc loc)
-    | PaApp (loc, x1, x2) -> PaApp (floc loc, self x1, self x2)
-    | PaArr (loc, x1) -> PaArr (floc loc, List.map self x1)
-    | PaChr (loc, x1) -> PaChr (floc loc, x1)
-    | PaInt (loc, x1) -> PaInt (floc loc, x1)
-    | PaInt32 (loc, x1) -> PaInt32 (floc loc, x1)
-    | PaInt64 (loc, x1) -> PaInt64 (floc loc, x1)
-    | PaNativeInt (loc, x1) -> PaNativeInt (floc loc, x1)
-    | PaFlo (loc, x1) -> PaFlo (floc loc, x1)
-    | PaLab (loc, x1, x2) -> PaLab (floc loc, x1, option_map self x2)
-    | PaLid (loc, x1) -> PaLid (floc loc, x1)
+        patt
+          (fun lloc -> adjust_loc (adjust_pos sh (fst loc)) (linearize lloc))
+          zero_loc x1
+    | PaAny loc -> let nloc = floc loc in PaAny nloc
+    | PaApp (loc, x1, x2) ->
+        let nloc = floc loc in PaApp (nloc, self x1, self x2)
+    | PaArr (loc, x1) -> let nloc = floc loc in PaArr (nloc, List.map self x1)
+    | PaChr (loc, x1) -> let nloc = floc loc in PaChr (nloc, x1)
+    | PaInt (loc, x1) -> let nloc = floc loc in PaInt (nloc, x1)
+    | PaInt32 (loc, x1) -> let nloc = floc loc in PaInt32 (nloc, x1)
+    | PaInt64 (loc, x1) -> let nloc = floc loc in PaInt64 (nloc, x1)
+    | PaNativeInt (loc, x1) -> let nloc = floc loc in PaNativeInt (nloc, x1)
+    | PaFlo (loc, x1) -> let nloc = floc loc in PaFlo (nloc, x1)
+    | PaLab (loc, x1, x2) ->
+        let nloc = floc loc in PaLab (nloc, x1, option_map self x2)
+    | PaLid (loc, x1) -> let nloc = floc loc in PaLid (nloc, x1)
     | PaOlb (loc, x1, x2) ->
+        let nloc = floc loc in
         PaOlb
-          (floc loc, x1,
+          (nloc, x1,
            option_map (fun (x1, x2) -> self x1, option_map (expr floc sh) x2)
              x2)
-    | PaOrp (loc, x1, x2) -> PaOrp (floc loc, self x1, self x2)
-    | PaRng (loc, x1, x2) -> PaRng (floc loc, self x1, self x2)
+    | PaOrp (loc, x1, x2) ->
+        let nloc = floc loc in PaOrp (nloc, self x1, self x2)
+    | PaRng (loc, x1, x2) ->
+        let nloc = floc loc in PaRng (nloc, self x1, self x2)
     | PaRec (loc, x1) ->
-        PaRec (floc loc, List.map (fun (x1, x2) -> self x1, self x2) x1)
-    | PaStr (loc, x1) -> PaStr (floc loc, x1)
-    | PaTup (loc, x1) -> PaTup (floc loc, List.map self x1)
-    | PaTyc (loc, x1, x2) -> PaTyc (floc loc, self x1, ctyp floc sh x2)
-    | PaTyp (loc, x1) -> PaTyp (floc loc, x1)
-    | PaUid (loc, x1) -> PaUid (floc loc, x1)
-    | PaVrn (loc, x1) -> PaVrn (floc loc, x1)
+        let nloc = floc loc in
+        PaRec (nloc, List.map (fun (x1, x2) -> self x1, self x2) x1)
+    | PaStr (loc, x1) -> let nloc = floc loc in PaStr (nloc, x1)
+    | PaTup (loc, x1) -> let nloc = floc loc in PaTup (nloc, List.map self x1)
+    | PaTyc (loc, x1, x2) ->
+        let nloc = floc loc in PaTyc (nloc, self x1, ctyp floc sh x2)
+    | PaTyp (loc, x1) -> let nloc = floc loc in PaTyp (nloc, x1)
+    | PaUid (loc, x1) -> let nloc = floc loc in PaUid (nloc, x1)
+    | PaVrn (loc, x1) -> let nloc = floc loc in PaVrn (nloc, x1)
   in
   self
 and expr floc sh =
   let rec self =
     function
-      ExAcc (loc, x1, x2) -> ExAcc (floc loc, self x1, self x2)
+      ExAcc (loc, x1, x2) ->
+        let nloc = floc loc in ExAcc (nloc, self x1, self x2)
     | ExAnt (loc, x1) ->
-        expr (fun (p1, p2) -> sh + fst loc + p1, sh + fst loc + p2) 0 x1
-    | ExApp (loc, x1, x2) -> ExApp (floc loc, self x1, self x2)
-    | ExAre (loc, x1, x2) -> ExAre (floc loc, self x1, self x2)
-    | ExArr (loc, x1) -> ExArr (floc loc, List.map self x1)
-    | ExAsf loc -> ExAsf (floc loc)
-    | ExAsr (loc, x1) -> ExAsr (floc loc, self x1)
-    | ExAss (loc, x1, x2) -> ExAss (floc loc, self x1, self x2)
-    | ExChr (loc, x1) -> ExChr (floc loc, x1)
+        expr
+          (fun lloc -> adjust_loc (adjust_pos sh (fst loc)) (linearize lloc))
+          zero_loc x1
+    | ExApp (loc, x1, x2) ->
+        let nloc = floc loc in ExApp (nloc, self x1, self x2)
+    | ExAre (loc, x1, x2) ->
+        let nloc = floc loc in ExAre (nloc, self x1, self x2)
+    | ExArr (loc, x1) -> let nloc = floc loc in ExArr (nloc, List.map self x1)
+    | ExAsf loc -> let nloc = floc loc in ExAsf nloc
+    | ExAsr (loc, x1) -> let nloc = floc loc in ExAsr (nloc, self x1)
+    | ExAss (loc, x1, x2) ->
+        let nloc = floc loc in ExAss (nloc, self x1, self x2)
+    | ExChr (loc, x1) -> let nloc = floc loc in ExChr (nloc, x1)
     | ExCoe (loc, x1, x2, x3) ->
-        ExCoe
-          (floc loc, self x1, option_map (ctyp floc sh) x2, ctyp floc sh x3)
-    | ExFlo (loc, x1) -> ExFlo (floc loc, x1)
+        let nloc = floc loc in
+        ExCoe (nloc, self x1, option_map (ctyp floc sh) x2, ctyp floc sh x3)
+    | ExFlo (loc, x1) -> let nloc = floc loc in ExFlo (nloc, x1)
     | ExFor (loc, x1, x2, x3, x4, x5) ->
-        ExFor (floc loc, x1, self x2, self x3, x4, List.map self x5)
+        let nloc = floc loc in
+        ExFor (nloc, x1, self x2, self x3, x4, List.map self x5)
     | ExFun (loc, x1) ->
+        let nloc = floc loc in
         ExFun
-          (floc loc,
+          (nloc,
            List.map
              (fun (x1, x2, x3) ->
                 patt floc sh x1, option_map self x2, self x3)
              x1)
-    | ExIfe (loc, x1, x2, x3) -> ExIfe (floc loc, self x1, self x2, self x3)
-    | ExInt (loc, x1) -> ExInt (floc loc, x1)
-    | ExInt32 (loc, x1) -> ExInt32 (floc loc, x1)
-    | ExInt64 (loc, x1) -> ExInt64 (floc loc, x1)
-    | ExNativeInt (loc, x1) -> ExNativeInt (floc loc, x1)
-    | ExLab (loc, x1, x2) -> ExLab (floc loc, x1, option_map self x2)
-    | ExLaz (loc, x1) -> ExLaz (floc loc, self x1)
+    | ExIfe (loc, x1, x2, x3) ->
+        let nloc = floc loc in ExIfe (nloc, self x1, self x2, self x3)
+    | ExInt (loc, x1) -> let nloc = floc loc in ExInt (nloc, x1)
+    | ExInt32 (loc, x1) -> let nloc = floc loc in ExInt32 (nloc, x1)
+    | ExInt64 (loc, x1) -> let nloc = floc loc in ExInt64 (nloc, x1)
+    | ExNativeInt (loc, x1) -> let nloc = floc loc in ExNativeInt (nloc, x1)
+    | ExLab (loc, x1, x2) ->
+        let nloc = floc loc in ExLab (nloc, x1, option_map self x2)
+    | ExLaz (loc, x1) -> let nloc = floc loc in ExLaz (nloc, self x1)
     | ExLet (loc, x1, x2, x3) ->
+        let nloc = floc loc in
         ExLet
-          (floc loc, x1,
-           List.map (fun (x1, x2) -> patt floc sh x1, self x2) x2, self x3)
-    | ExLid (loc, x1) -> ExLid (floc loc, x1)
+          (nloc, x1, List.map (fun (x1, x2) -> patt floc sh x1, self x2) x2,
+           self x3)
+    | ExLid (loc, x1) -> let nloc = floc loc in ExLid (nloc, x1)
     | ExLmd (loc, x1, x2, x3) ->
-        ExLmd (floc loc, x1, module_expr floc sh x2, self x3)
+        let nloc = floc loc in
+        ExLmd (nloc, x1, module_expr floc sh x2, self x3)
     | ExMat (loc, x1, x2) ->
+        let nloc = floc loc in
         ExMat
-          (floc loc, self x1,
+          (nloc, self x1,
            List.map
              (fun (x1, x2, x3) ->
                 patt floc sh x1, option_map self x2, self x3)
              x2)
-    | ExNew (loc, x1) -> ExNew (floc loc, x1)
-    | ExOlb (loc, x1, x2) -> ExOlb (floc loc, x1, option_map self x2)
+    | ExNew (loc, x1) -> let nloc = floc loc in ExNew (nloc, x1)
+    | ExObj (loc, x1, x2) ->
+        let nloc = floc loc in
+        ExObj
+          (nloc, option_map (patt floc sh) x1,
+           List.map (class_str_item floc sh) x2)
+    | ExOlb (loc, x1, x2) ->
+        let nloc = floc loc in ExOlb (nloc, x1, option_map self x2)
     | ExOvr (loc, x1) ->
-        ExOvr (floc loc, List.map (fun (x1, x2) -> x1, self x2) x1)
+        let nloc = floc loc in
+        ExOvr (nloc, List.map (fun (x1, x2) -> x1, self x2) x1)
     | ExRec (loc, x1, x2) ->
+        let nloc = floc loc in
         ExRec
-          (floc loc, List.map (fun (x1, x2) -> patt floc sh x1, self x2) x1,
+          (nloc, List.map (fun (x1, x2) -> patt floc sh x1, self x2) x1,
            option_map self x2)
-    | ExSeq (loc, x1) -> ExSeq (floc loc, List.map self x1)
-    | ExSnd (loc, x1, x2) -> ExSnd (floc loc, self x1, x2)
-    | ExSte (loc, x1, x2) -> ExSte (floc loc, self x1, self x2)
-    | ExStr (loc, x1) -> ExStr (floc loc, x1)
+    | ExSeq (loc, x1) -> let nloc = floc loc in ExSeq (nloc, List.map self x1)
+    | ExSnd (loc, x1, x2) -> let nloc = floc loc in ExSnd (nloc, self x1, x2)
+    | ExSte (loc, x1, x2) ->
+        let nloc = floc loc in ExSte (nloc, self x1, self x2)
+    | ExStr (loc, x1) -> let nloc = floc loc in ExStr (nloc, x1)
     | ExTry (loc, x1, x2) ->
+        let nloc = floc loc in
         ExTry
-          (floc loc, self x1,
+          (nloc, self x1,
            List.map
              (fun (x1, x2, x3) ->
                 patt floc sh x1, option_map self x2, self x3)
              x2)
-    | ExTup (loc, x1) -> ExTup (floc loc, List.map self x1)
-    | ExTyc (loc, x1, x2) -> ExTyc (floc loc, self x1, ctyp floc sh x2)
-    | ExUid (loc, x1) -> ExUid (floc loc, x1)
-    | ExVrn (loc, x1) -> ExVrn (floc loc, x1)
-    | ExWhi (loc, x1, x2) -> ExWhi (floc loc, self x1, List.map self x2)
+    | ExTup (loc, x1) -> let nloc = floc loc in ExTup (nloc, List.map self x1)
+    | ExTyc (loc, x1, x2) ->
+        let nloc = floc loc in ExTyc (nloc, self x1, ctyp floc sh x2)
+    | ExUid (loc, x1) -> let nloc = floc loc in ExUid (nloc, x1)
+    | ExVrn (loc, x1) -> let nloc = floc loc in ExVrn (nloc, x1)
+    | ExWhi (loc, x1, x2) ->
+        let nloc = floc loc in ExWhi (nloc, self x1, List.map self x2)
   in
   self
 and module_type floc sh =
   let rec self =
     function
-      MtAcc (loc, x1, x2) -> MtAcc (floc loc, self x1, self x2)
-    | MtApp (loc, x1, x2) -> MtApp (floc loc, self x1, self x2)
-    | MtFun (loc, x1, x2, x3) -> MtFun (floc loc, x1, self x2, self x3)
-    | MtLid (loc, x1) -> MtLid (floc loc, x1)
-    | MtQuo (loc, x1) -> MtQuo (floc loc, x1)
-    | MtSig (loc, x1) -> MtSig (floc loc, List.map (sig_item floc sh) x1)
-    | MtUid (loc, x1) -> MtUid (floc loc, x1)
+      MtAcc (loc, x1, x2) ->
+        let nloc = floc loc in MtAcc (nloc, self x1, self x2)
+    | MtApp (loc, x1, x2) ->
+        let nloc = floc loc in MtApp (nloc, self x1, self x2)
+    | MtFun (loc, x1, x2, x3) ->
+        let nloc = floc loc in MtFun (nloc, x1, self x2, self x3)
+    | MtLid (loc, x1) -> let nloc = floc loc in MtLid (nloc, x1)
+    | MtQuo (loc, x1) -> let nloc = floc loc in MtQuo (nloc, x1)
+    | MtSig (loc, x1) ->
+        let nloc = floc loc in MtSig (nloc, List.map (sig_item floc sh) x1)
+    | MtUid (loc, x1) -> let nloc = floc loc in MtUid (nloc, x1)
     | MtWit (loc, x1, x2) ->
-        MtWit (floc loc, self x1, List.map (with_constr floc sh) x2)
+        let nloc = floc loc in
+        MtWit (nloc, self x1, List.map (with_constr floc sh) x2)
   in
   self
 and sig_item floc sh =
   let rec self =
     function
       SgCls (loc, x1) ->
-        SgCls (floc loc, List.map (class_infos class_type floc sh) x1)
+        let nloc = floc loc in
+        SgCls (nloc, List.map (class_infos class_type floc sh) x1)
     | SgClt (loc, x1) ->
-        SgClt (floc loc, List.map (class_infos class_type floc sh) x1)
-    | SgDcl (loc, x1) -> SgDcl (floc loc, List.map self x1)
-    | SgDir (loc, x1, x2) -> SgDir (floc loc, x1, x2)
-    | SgExc (loc, x1, x2) -> SgExc (floc loc, x1, List.map (ctyp floc sh) x2)
-    | SgExt (loc, x1, x2, x3) -> SgExt (floc loc, x1, ctyp floc sh x2, x3)
-    | SgInc (loc, x1) -> SgInc (floc loc, module_type floc sh x1)
-    | SgMod (loc, x1, x2) -> SgMod (floc loc, x1, module_type floc sh x2)
+        let nloc = floc loc in
+        SgClt (nloc, List.map (class_infos class_type floc sh) x1)
+    | SgDcl (loc, x1) -> let nloc = floc loc in SgDcl (nloc, List.map self x1)
+    | SgDir (loc, x1, x2) -> let nloc = floc loc in SgDir (nloc, x1, x2)
+    | SgExc (loc, x1, x2) ->
+        let nloc = floc loc in SgExc (nloc, x1, List.map (ctyp floc sh) x2)
+    | SgExt (loc, x1, x2, x3) ->
+        let nloc = floc loc in SgExt (nloc, x1, ctyp floc sh x2, x3)
+    | SgInc (loc, x1) ->
+        let nloc = floc loc in SgInc (nloc, module_type floc sh x1)
+    | SgMod (loc, x1, x2) ->
+        let nloc = floc loc in SgMod (nloc, x1, module_type floc sh x2)
     | SgRecMod (loc, xxs) ->
+        let nloc = floc loc in
         SgRecMod
-          (floc loc,
-           List.map (fun (x1, x2) -> x1, module_type floc sh x2) xxs)
-    | SgMty (loc, x1, x2) -> SgMty (floc loc, x1, module_type floc sh x2)
-    | SgOpn (loc, x1) -> SgOpn (floc loc, x1)
+          (nloc, List.map (fun (x1, x2) -> x1, module_type floc sh x2) xxs)
+    | SgMty (loc, x1, x2) ->
+        let nloc = floc loc in SgMty (nloc, x1, module_type floc sh x2)
+    | SgOpn (loc, x1) -> let nloc = floc loc in SgOpn (nloc, x1)
     | SgTyp (loc, x1) ->
+        let nloc = floc loc in
         SgTyp
-          (floc loc,
+          (nloc,
            List.map
              (fun ((loc, x1), x2, x3, x4) ->
                 (floc loc, x1), x2, ctyp floc sh x3,
@@ -214,55 +332,72 @@ and sig_item floc sh =
                   x4)
              x1)
     | SgUse (loc, x1, x2) -> SgUse (loc, x1, x2)
-    | SgVal (loc, x1, x2) -> SgVal (floc loc, x1, ctyp floc sh x2)
+    | SgVal (loc, x1, x2) ->
+        let nloc = floc loc in SgVal (nloc, x1, ctyp floc sh x2)
   in
   self
 and with_constr floc sh =
   let rec self =
     function
-      WcTyp (loc, x1, x2, x3) -> WcTyp (floc loc, x1, x2, ctyp floc sh x3)
-    | WcMod (loc, x1, x2) -> WcMod (floc loc, x1, module_expr floc sh x2)
+      WcTyp (loc, x1, x2, x3) ->
+        let nloc = floc loc in WcTyp (nloc, x1, x2, ctyp floc sh x3)
+    | WcMod (loc, x1, x2) ->
+        let nloc = floc loc in WcMod (nloc, x1, module_expr floc sh x2)
   in
   self
 and module_expr floc sh =
   let rec self =
     function
-      MeAcc (loc, x1, x2) -> MeAcc (floc loc, self x1, self x2)
-    | MeApp (loc, x1, x2) -> MeApp (floc loc, self x1, self x2)
+      MeAcc (loc, x1, x2) ->
+        let nloc = floc loc in MeAcc (nloc, self x1, self x2)
+    | MeApp (loc, x1, x2) ->
+        let nloc = floc loc in MeApp (nloc, self x1, self x2)
     | MeFun (loc, x1, x2, x3) ->
-        MeFun (floc loc, x1, module_type floc sh x2, self x3)
-    | MeStr (loc, x1) -> MeStr (floc loc, List.map (str_item floc sh) x1)
-    | MeTyc (loc, x1, x2) -> MeTyc (floc loc, self x1, module_type floc sh x2)
-    | MeUid (loc, x1) -> MeUid (floc loc, x1)
+        let nloc = floc loc in
+        MeFun (nloc, x1, module_type floc sh x2, self x3)
+    | MeStr (loc, x1) ->
+        let nloc = floc loc in MeStr (nloc, List.map (str_item floc sh) x1)
+    | MeTyc (loc, x1, x2) ->
+        let nloc = floc loc in MeTyc (nloc, self x1, module_type floc sh x2)
+    | MeUid (loc, x1) -> let nloc = floc loc in MeUid (nloc, x1)
   in
   self
 and str_item floc sh =
   let rec self =
     function
       StCls (loc, x1) ->
-        StCls (floc loc, List.map (class_infos class_expr floc sh) x1)
+        let nloc = floc loc in
+        StCls (nloc, List.map (class_infos class_expr floc sh) x1)
     | StClt (loc, x1) ->
-        StClt (floc loc, List.map (class_infos class_type floc sh) x1)
-    | StDcl (loc, x1) -> StDcl (floc loc, List.map self x1)
-    | StDir (loc, x1, x2) -> StDir (floc loc, x1, x2)
+        let nloc = floc loc in
+        StClt (nloc, List.map (class_infos class_type floc sh) x1)
+    | StDcl (loc, x1) -> let nloc = floc loc in StDcl (nloc, List.map self x1)
+    | StDir (loc, x1, x2) -> let nloc = floc loc in StDir (nloc, x1, x2)
     | StExc (loc, x1, x2, x3) ->
-        StExc (floc loc, x1, List.map (ctyp floc sh) x2, x3)
-    | StExp (loc, x1) -> StExp (floc loc, expr floc sh x1)
-    | StExt (loc, x1, x2, x3) -> StExt (floc loc, x1, ctyp floc sh x2, x3)
-    | StInc (loc, x1) -> StInc (floc loc, module_expr floc sh x1)
-    | StMod (loc, x1, x2) -> StMod (floc loc, x1, module_expr floc sh x2)
+        let nloc = floc loc in
+        StExc (nloc, x1, List.map (ctyp floc sh) x2, x3)
+    | StExp (loc, x1) -> let nloc = floc loc in StExp (nloc, expr floc sh x1)
+    | StExt (loc, x1, x2, x3) ->
+        let nloc = floc loc in StExt (nloc, x1, ctyp floc sh x2, x3)
+    | StInc (loc, x1) ->
+        let nloc = floc loc in StInc (nloc, module_expr floc sh x1)
+    | StMod (loc, x1, x2) ->
+        let nloc = floc loc in StMod (nloc, x1, module_expr floc sh x2)
     | StRecMod (loc, nmtmes) ->
+        let nloc = floc loc in
         StRecMod
-          (floc loc,
+          (nloc,
            List.map
              (fun (n, mt, me) ->
                 n, module_type floc sh mt, module_expr floc sh me)
              nmtmes)
-    | StMty (loc, x1, x2) -> StMty (floc loc, x1, module_type floc sh x2)
-    | StOpn (loc, x1) -> StOpn (floc loc, x1)
+    | StMty (loc, x1, x2) ->
+        let nloc = floc loc in StMty (nloc, x1, module_type floc sh x2)
+    | StOpn (loc, x1) -> let nloc = floc loc in StOpn (nloc, x1)
     | StTyp (loc, x1) ->
+        let nloc = floc loc in
         StTyp
-          (floc loc,
+          (nloc,
            List.map
              (fun ((loc, x1), x2, x3, x4) ->
                 (floc loc, x1), x2, ctyp floc sh x3,
@@ -271,19 +406,23 @@ and str_item floc sh =
              x1)
     | StUse (loc, x1, x2) -> StUse (loc, x1, x2)
     | StVal (loc, x1, x2) ->
+        let nloc = floc loc in
         StVal
-          (floc loc, x1,
+          (nloc, x1,
            List.map (fun (x1, x2) -> patt floc sh x1, expr floc sh x2) x2)
   in
   self
 and class_type floc sh =
   let rec self =
     function
-      CtCon (loc, x1, x2) -> CtCon (floc loc, x1, List.map (ctyp floc sh) x2)
-    | CtFun (loc, x1, x2) -> CtFun (floc loc, ctyp floc sh x1, self x2)
+      CtCon (loc, x1, x2) ->
+        let nloc = floc loc in CtCon (nloc, x1, List.map (ctyp floc sh) x2)
+    | CtFun (loc, x1, x2) ->
+        let nloc = floc loc in CtFun (nloc, ctyp floc sh x1, self x2)
     | CtSig (loc, x1, x2) ->
+        let nloc = floc loc in
         CtSig
-          (floc loc, option_map (ctyp floc sh) x1,
+          (nloc, option_map (ctyp floc sh) x1,
            List.map (class_sig_item floc sh) x2)
   in
   self
@@ -291,47 +430,62 @@ and class_sig_item floc sh =
   let rec self =
     function
       CgCtr (loc, x1, x2) ->
-        CgCtr (floc loc, ctyp floc sh x1, ctyp floc sh x2)
+        let nloc = floc loc in CgCtr (nloc, ctyp floc sh x1, ctyp floc sh x2)
     | CgDcl (loc, x1) ->
-        CgDcl (floc loc, List.map (class_sig_item floc sh) x1)
-    | CgInh (loc, x1) -> CgInh (floc loc, class_type floc sh x1)
-    | CgMth (loc, x1, x2, x3) -> CgMth (floc loc, x1, x2, ctyp floc sh x3)
-    | CgVal (loc, x1, x2, x3) -> CgVal (floc loc, x1, x2, ctyp floc sh x3)
-    | CgVir (loc, x1, x2, x3) -> CgVir (floc loc, x1, x2, ctyp floc sh x3)
+        let nloc = floc loc in
+        CgDcl (nloc, List.map (class_sig_item floc sh) x1)
+    | CgInh (loc, x1) ->
+        let nloc = floc loc in CgInh (nloc, class_type floc sh x1)
+    | CgMth (loc, x1, x2, x3) ->
+        let nloc = floc loc in CgMth (nloc, x1, x2, ctyp floc sh x3)
+    | CgVal (loc, x1, x2, x3) ->
+        let nloc = floc loc in CgVal (nloc, x1, x2, ctyp floc sh x3)
+    | CgVir (loc, x1, x2, x3) ->
+        let nloc = floc loc in CgVir (nloc, x1, x2, ctyp floc sh x3)
   in
   self
 and class_expr floc sh =
   let rec self =
     function
-      CeApp (loc, x1, x2) -> CeApp (floc loc, self x1, expr floc sh x2)
-    | CeCon (loc, x1, x2) -> CeCon (floc loc, x1, List.map (ctyp floc sh) x2)
-    | CeFun (loc, x1, x2) -> CeFun (floc loc, patt floc sh x1, self x2)
+      CeApp (loc, x1, x2) ->
+        let nloc = floc loc in CeApp (nloc, self x1, expr floc sh x2)
+    | CeCon (loc, x1, x2) ->
+        let nloc = floc loc in CeCon (nloc, x1, List.map (ctyp floc sh) x2)
+    | CeFun (loc, x1, x2) ->
+        let nloc = floc loc in CeFun (nloc, patt floc sh x1, self x2)
     | CeLet (loc, x1, x2, x3) ->
+        let nloc = floc loc in
         CeLet
-          (floc loc, x1,
+          (nloc, x1,
            List.map (fun (x1, x2) -> patt floc sh x1, expr floc sh x2) x2,
            self x3)
     | CeStr (loc, x1, x2) ->
+        let nloc = floc loc in
         CeStr
-          (floc loc, option_map (patt floc sh) x1,
+          (nloc, option_map (patt floc sh) x1,
            List.map (class_str_item floc sh) x2)
-    | CeTyc (loc, x1, x2) -> CeTyc (floc loc, self x1, class_type floc sh x2)
+    | CeTyc (loc, x1, x2) ->
+        let nloc = floc loc in CeTyc (nloc, self x1, class_type floc sh x2)
   in
   self
 and class_str_item floc sh =
   let rec self =
     function
       CrCtr (loc, x1, x2) ->
-        CrCtr (floc loc, ctyp floc sh x1, ctyp floc sh x2)
+        let nloc = floc loc in CrCtr (nloc, ctyp floc sh x1, ctyp floc sh x2)
     | CrDcl (loc, x1) ->
-        CrDcl (floc loc, List.map (class_str_item floc sh) x1)
-    | CrInh (loc, x1, x2) -> CrInh (floc loc, class_expr floc sh x1, x2)
-    | CrIni (loc, x1) -> CrIni (floc loc, expr floc sh x1)
+        let nloc = floc loc in
+        CrDcl (nloc, List.map (class_str_item floc sh) x1)
+    | CrInh (loc, x1, x2) ->
+        let nloc = floc loc in CrInh (nloc, class_expr floc sh x1, x2)
+    | CrIni (loc, x1) -> let nloc = floc loc in CrIni (nloc, expr floc sh x1)
     | CrMth (loc, x1, x2, x3, x4) ->
-        CrMth
-          (floc loc, x1, x2, expr floc sh x3, option_map (ctyp floc sh) x4)
-    | CrVal (loc, x1, x2, x3) -> CrVal (floc loc, x1, x2, expr floc sh x3)
-    | CrVir (loc, x1, x2, x3) -> CrVir (floc loc, x1, x2, ctyp floc sh x3)
+        let nloc = floc loc in
+        CrMth (nloc, x1, x2, expr floc sh x3, option_map (ctyp floc sh) x4)
+    | CrVal (loc, x1, x2, x3) ->
+        let nloc = floc loc in CrVal (nloc, x1, x2, expr floc sh x3)
+    | CrVir (loc, x1, x2, x3) ->
+        let nloc = floc loc in CrVir (nloc, x1, x2, ctyp floc sh x3)
   in
   self
 ;;
diff --git a/camlp4/ocaml_src/camlp4/reloc.mli b/camlp4/ocaml_src/camlp4/reloc.mli
index 21018b52af..7d4f2bcb6a 100644
--- a/camlp4/ocaml_src/camlp4/reloc.mli
+++ b/camlp4/ocaml_src/camlp4/reloc.mli
@@ -12,5 +12,11 @@
 
 (* This file has been generated by program: do not edit! *)
 
-val patt : (MLast.loc -> MLast.loc) -> int -> MLast.patt -> MLast.patt;;
-val expr : (MLast.loc -> MLast.loc) -> int -> MLast.expr -> MLast.expr;;
+val zero_loc : Lexing.position;;
+val shift_pos : int -> Lexing.position -> Lexing.position;;
+val adjust_loc : Lexing.position -> MLast.loc -> MLast.loc;;
+val linearize : MLast.loc -> MLast.loc;;
+val patt :
+  (MLast.loc -> MLast.loc) -> Lexing.position -> MLast.patt -> MLast.patt;;
+val expr :
+  (MLast.loc -> MLast.loc) -> Lexing.position -> MLast.expr -> MLast.expr;;
diff --git a/camlp4/ocaml_src/lib/.depend b/camlp4/ocaml_src/lib/.depend
index 0d5adc691f..d7afaebeb2 100644
--- a/camlp4/ocaml_src/lib/.depend
+++ b/camlp4/ocaml_src/lib/.depend
@@ -2,6 +2,7 @@ extfold.cmi: gramext.cmi
 gramext.cmi: token.cmi 
 grammar.cmi: gramext.cmi token.cmi 
 plexer.cmi: token.cmi 
+stdpp.cmi: token.cmi 
 extfold.cmo: gramext.cmi grammar.cmi extfold.cmi 
 extfold.cmx: gramext.cmx grammar.cmx extfold.cmi 
 extfun.cmo: extfun.cmi 
@@ -14,7 +15,7 @@ grammar.cmo: gramext.cmi stdpp.cmi token.cmi grammar.cmi
 grammar.cmx: gramext.cmx stdpp.cmx token.cmx grammar.cmi 
 plexer.cmo: stdpp.cmi token.cmi plexer.cmi 
 plexer.cmx: stdpp.cmx token.cmx plexer.cmi 
-stdpp.cmo: stdpp.cmi 
-stdpp.cmx: stdpp.cmi 
+stdpp.cmo: token.cmi stdpp.cmi 
+stdpp.cmx: token.cmx stdpp.cmi 
 token.cmo: token.cmi 
 token.cmx: token.cmi 
diff --git a/camlp4/ocaml_src/lib/Makefile b/camlp4/ocaml_src/lib/Makefile
index e19e52052b..9119b7aa96 100644
--- a/camlp4/ocaml_src/lib/Makefile
+++ b/camlp4/ocaml_src/lib/Makefile
@@ -43,6 +43,6 @@ install:
 
 installopt:
 	cp $(TARGET:.cma=.cmxa) *.cmx "$(LIBDIR)/camlp4/."
-	tar cf - $(TARGET:.cma=.$(A)) | (cd "$(LIBDIR)/camlp4/."; tar xf -)
+	TARG=`echo "$(TARGET)" | sed -e "s/\.cma\$$/.$(A)/g"` && tar cf - $$TARG | (cd "$(LIBDIR)/camlp4/." && tar xf -)
 
 include .depend
diff --git a/camlp4/ocaml_src/lib/grammar.ml b/camlp4/ocaml_src/lib/grammar.ml
index 196a6b954a..3501976d1a 100644
--- a/camlp4/ocaml_src/lib/grammar.ml
+++ b/camlp4/ocaml_src/lib/grammar.ml
@@ -194,11 +194,13 @@ external grammar_obj : g -> Token.t grammar = "%identity";;
 let floc = ref (fun _ -> failwith "internal error when computing location");;
 let loc_of_token_interval bp ep =
   if bp == ep then
-    if bp == 0 then 0, 1 else let a = snd (!floc (bp - 1)) in a, a + 1
+    if bp == 0 then Token.nowhere, Token.succ_pos Token.nowhere
+    else let a = snd (!floc (bp - 1)) in a, Token.succ_pos a
   else
     let (bp1, bp2) = !floc bp in
     let (ep1, ep2) = !floc (pred ep) in
-    (if bp1 < ep1 then bp1 else ep1), (if bp2 > ep2 then bp2 else ep2)
+    (if Token.lt_pos bp1 ep1 then bp1 else ep1),
+    (if Token.lt_pos ep2 bp2 then bp2 else ep2)
 ;;
 
 let rec name_of_symbol entry =
@@ -805,7 +807,7 @@ let parse_parsable entry efun (cs, (ts, fun_loc)) =
       if !token_count - 1 <= cnt then loc
       else fst loc, snd (fun_loc (!token_count - 1))
     with
-      _ -> Stream.count cs, Stream.count cs + 1
+      _ -> Token.nowhere, Token.succ_pos Token.nowhere
   in
   floc := fun_loc;
   token_count := 0;
@@ -817,7 +819,7 @@ let parse_parsable entry efun (cs, (ts, fun_loc)) =
   | Stream.Error _ as exc ->
       let loc = get_loc () in restore (); raise_with_loc loc exc
   | exc ->
-      let loc = Stream.count cs, Stream.count cs + 1 in
+      let loc = Token.nowhere, Token.succ_pos Token.nowhere in
       restore (); raise_with_loc loc exc
 ;;
 
@@ -1060,7 +1062,7 @@ module type ReinitType = sig val reinit_gram : g -> Token.lexer -> unit;; end
 module GGMake (R : ReinitType) (L : GLexerType) =
   struct
     type te = L.te;;
-    type parsable = char Stream.t * (te Stream.t * Token.location_function);;
+    type parsable = char Stream.t * (te Stream.t * Token.flocation_function);;
     let gram = gcreate L.lexer;;
     let parsable cs = cs, L.lexer.Token.tok_func cs;;
     let tokens = tokens gram;;
diff --git a/camlp4/ocaml_src/lib/grammar.mli b/camlp4/ocaml_src/lib/grammar.mli
index d38b449f95..34dee1b3eb 100644
--- a/camlp4/ocaml_src/lib/grammar.mli
+++ b/camlp4/ocaml_src/lib/grammar.mli
@@ -183,7 +183,7 @@ val create : Token.lexer -> g;;
 
 (*** For system use *)
 
-val loc_of_token_interval : int -> int -> int * int;;
+val loc_of_token_interval : int -> int -> Token.flocation;;
 val extend :
   ('te Gramext.g_entry * Gramext.position option *
      (string option * Gramext.g_assoc option *
diff --git a/camlp4/ocaml_src/lib/plexer.ml b/camlp4/ocaml_src/lib/plexer.ml
index 4b5dcca151..43d5c8d95a 100644
--- a/camlp4/ocaml_src/lib/plexer.ml
+++ b/camlp4/ocaml_src/lib/plexer.ml
@@ -92,6 +92,9 @@ and digits_under kind len (strm__ : _ Stream.t) =
   | _ ->
       match Stream.peek strm__ with
         Some '_' -> Stream.junk strm__; digits_under kind len strm__
+      | Some 'l' -> Stream.junk strm__; "INT32", get_buff len
+      | Some 'L' -> Stream.junk strm__; "INT64", get_buff len
+      | Some 'n' -> Stream.junk strm__; "NATIVEINT", get_buff len
       | _ -> "INT", get_buff len
 and octal (strm__ : _ Stream.t) =
   match Stream.peek strm__ with
@@ -145,371 +148,85 @@ and end_exponent_part_under len (strm__ : _ Stream.t) =
 let error_on_unknown_keywords = ref false;;
 let err loc msg = raise_with_loc loc (Token.Error msg);;
 
-(*
-value next_token_fun dfa find_kwd =
-  let keyword_or_error loc s =
-    try (("", find_kwd s), loc) with
-    [ Not_found ->
-        if error_on_unknown_keywords.val then err loc ("illegal token: " ^ s)
-        else (("", s), loc) ]
-  in
-  let rec next_token =
-    parser bp
-    [ [: `' ' | '\010' | '\013' | '\t' | '\026' | '\012'; s :] ->
-        next_token s
-    | [: `'('; s :] -> left_paren bp s
-    | [: `'#'; s :] -> do { spaces_tabs s; linenum bp s }
-    | [: `('A'..'Z' | '\192'..'\214' | '\216'..'\222' as c); s :] ->
-        let id = get_buff (ident (store 0 c) s) in
-        let loc = (bp, Stream.count s) in
-        (try ("", find_kwd id) with [ Not_found -> ("UIDENT", id) ], loc)
-    | [: `('a'..'z' | '\223'..'\246' | '\248'..'\255' | '_' as c); s :] ->
-        let id = get_buff (ident (store 0 c) s) in
-        let loc = (bp, Stream.count s) in
-        (try ("", find_kwd id) with [ Not_found -> ("LIDENT", id) ], loc)
-    | [: `('1'..'9' as c); s :] ->
-        let tok = number (store 0 c) s in
-        let loc = (bp, Stream.count s) in
-        (tok, loc)
-    | [: `'0'; s :] ->
-        let tok = base_number (store 0 '0') s in
-        let loc = (bp, Stream.count s) in
-        (tok, loc)
-    | [: `'''; s :] ->
-        match Stream.npeek 3 s with
-        [ [_; '''; _] | ['\\'; _; _] | ['\x0D'; '\x0A'; '''] ->
-            let tok = ("CHAR", get_buff (char bp 0 s)) in
-            let loc = (bp, Stream.count s) in
-            (tok, loc)
-        | _ -> keyword_or_error (bp, Stream.count s) "'" ]
-    | [: `'"'; s :] ->
-        let tok = ("STRING", get_buff (string bp 0 s)) in
-        let loc = (bp, Stream.count s) in
-        (tok, loc)
-    | [: `'$'; s :] ->
-        let tok = dollar bp 0 s in
-        let loc = (bp, Stream.count s) in
-        (tok, loc)
-    | [: `('!' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | '%' as c);
-         s :] ->
-        let id = get_buff (ident2 (store 0 c) s) in
-        keyword_or_error (bp, Stream.count s) id
-    | [: `('~' as c);
-         a =
-           parser
-           [ [: `('a'..'z' as c); len = ident (store 0 c) :] ep ->
-               (("TILDEIDENT", get_buff len), (bp, ep))
-           | [: s :] ->
-               let id = get_buff (ident2 (store 0 c) s) in
-               keyword_or_error (bp, Stream.count s) id ] :] ->
-        a
-    | [: `('?' as c);
-         a =
-           parser
-           [ [: `('a'..'z' as c); len = ident (store 0 c) :] ep ->
-               (("QUESTIONIDENT", get_buff len), (bp, ep))
-           | [: s :] ->
-               let id = get_buff (ident2 (store 0 c) s) in
-               keyword_or_error (bp, Stream.count s) id ] :] ->
-        a
-    | [: `'<'; s :] -> less bp s
-    | [: `(':' as c1);
-         len =
-           parser
-           [ [: `(']' | ':' | '=' | '>' as c2) :] -> store (store 0 c1) c2
-           | [: :] -> store 0 c1 ] :] ep ->
-        let id = get_buff len in
-        keyword_or_error (bp, ep) id
-    | [: `('>' | '|' as c1);
-         len =
-           parser
-           [ [: `(']' | '}' as c2) :] -> store (store 0 c1) c2
-           | [: a = ident2 (store 0 c1) :] -> a ] :] ep ->
-        let id = get_buff len in
-        keyword_or_error (bp, ep) id
-    | [: `('[' | '{' as c1); s :] ->
-        let len =
-          match Stream.npeek 2 s with
-          [ ['<'; '<' | ':'] -> store 0 c1
-          | _ ->
-              match s with parser
-              [ [: `('|' | '<' | ':' as c2) :] -> store (store 0 c1) c2
-              | [: :] -> store 0 c1 ] ]
-        in
-        let ep = Stream.count s in
-        let id = get_buff len in
-        keyword_or_error (bp, ep) id
-    | [: `'.';
-         id =
-           parser
-           [ [: `'.' :] -> ".."
-           | [: :] -> if ssd && after_space then " ." else "." ] :] ep ->
-        keyword_or_error (bp, ep) id
-    | [: `';';
-         id =
-           parser
-           [ [: `';' :] -> ";;"
-           | [: :] -> ";" ] :] ep ->
-        keyword_or_error (bp, ep) id
-    | [: `'\\'; s :] ep -> (("LIDENT", get_buff (ident3 0 s)), (bp, ep))
-    | [: `c :] ep -> keyword_or_error (bp, ep) (String.make 1 c)
-    | [: _ = Stream.empty :] -> (("EOI", ""), (bp, succ bp)) ]
-  and less bp strm =
-    if no_quotations.val then
-      match strm with parser
-      [ [: len = ident2 (store 0 '<') :] ep ->
-          let id = get_buff len in
-          keyword_or_error (bp, ep) id ]
-    else
-      match strm with parser
-      [ [: `'<'; len = quotation bp 0 :] ep ->
-          (("QUOTATION", ":" ^ get_buff len), (bp, ep))
-      | [: `':'; i = parser [: len = ident 0 :] -> get_buff len;
-           `'<' ? "character '<' expected"; len = quotation bp 0 :] ep ->
-          (("QUOTATION", i ^ ":" ^ get_buff len), (bp, ep))
-      | [: len = ident2 (store 0 '<') :] ep ->
-          let id = get_buff len in
-          keyword_or_error (bp, ep) id ]
-  and string bp len =
-    parser
-    [ [: `'"' :] -> len
-    | [: `'\\'; `c; s :] -> string bp (store (store len '\\') c) s
-    | [: `c; s :] -> string bp (store len c) s
-    | [: :] ep -> err (bp, ep) "string not terminated" ]
-  and char bp len =
-    parser
-    [ [: `'''; s :] -> if len = 0 then char bp (store len ''') s else len
-    | [: `'\\'; `c; s :] -> char bp (store (store len '\\') c) s
-    | [: `c; s :] -> char bp (store len c) s
-    | [: :] ep -> err (bp, ep) "char not terminated" ]
-  and dollar bp len =
-    parser
-    [ [: `'$' :] -> ("ANTIQUOT", ":" ^ get_buff len)
-    | [: `('a'..'z' | 'A'..'Z' as c); s :] -> antiquot bp (store len c) s
-    | [: `('0'..'9' as c); s :] -> maybe_locate bp (store len c) s
-    | [: `':'; s :] ->
-        let k = get_buff len in
-        ("ANTIQUOT", k ^ ":" ^ locate_or_antiquot_rest bp 0 s)
-    | [: `'\\'; `c; s :] ->
-        ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s)
-    | [: s :] ->
-        if dfa then
-          match s with parser
-          [ [: `c :] ->
-              ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s)
-          | [: :] ep -> err (bp, ep) "antiquotation not terminated" ]
-        else ("", get_buff (ident2 (store 0 '$') s)) ]
-  and maybe_locate bp len =
-    parser
-    [ [: `'$' :] -> ("ANTIQUOT", ":" ^ get_buff len)
-    | [: `('0'..'9' as c); s :] -> maybe_locate bp (store len c) s
-    | [: `':'; s :] ->
-        ("LOCATE", get_buff len ^ ":" ^ locate_or_antiquot_rest bp 0 s)
-    | [: `'\\'; `c; s :] ->
-        ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s)
-    | [: `c; s :] ->
-        ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s)
-    | [: :] ep -> err (bp, ep) "antiquotation not terminated" ]
-  and antiquot bp len =
-    parser
-    [ [: `'$' :] -> ("ANTIQUOT", ":" ^ get_buff len)
-    | [: `('a'..'z' | 'A'..'Z' | '0'..'9' as c); s :] ->
-        antiquot bp (store len c) s
-    | [: `':'; s :] ->
-        let k = get_buff len in
-        ("ANTIQUOT", k ^ ":" ^ locate_or_antiquot_rest bp 0 s)
-    | [: `'\\'; `c; s :] ->
-        ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s)
-    | [: `c; s :] ->
-        ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s)
-    | [: :] ep -> err (bp, ep) "antiquotation not terminated" ]
-  and locate_or_antiquot_rest bp len =
-    parser
-    [ [: `'$' :] -> get_buff len
-    | [: `'\\'; `c; s :] -> locate_or_antiquot_rest bp (store len c) s
-    | [: `c; s :] -> locate_or_antiquot_rest bp (store len c) s
-    | [: :] ep -> err (bp, ep) "antiquotation not terminated" ]
-  and quotation bp len =
-    parser
-    [ [: `'>'; s :] -> maybe_end_quotation bp len s
-    | [: `'<'; s :] ->
-        quotation bp (maybe_nested_quotation bp (store len '<') s) s
-    | [: `'\\';
-         len =
-           parser
-           [ [: `('>' | '<' | '\\' as c) :] -> store len c
-           | [: :] -> store len '\\' ];
-         s :] ->
-        quotation bp len s
-    | [: `c; s :] -> quotation bp (store len c) s
-    | [: :] ep -> err (bp, ep) "quotation not terminated" ]
-  and maybe_nested_quotation bp len =
-    parser
-    [ [: `'<'; s :] -> mstore (quotation bp (store len '<') s) ">>"
-    | [: `':'; len = ident (store len ':');
-         a =
-           parser
-           [ [: `'<'; s :] -> mstore (quotation bp (store len '<') s) ">>"
-           | [: :] -> len ] :] ->
-        a
-    | [: :] -> len ]
-  and maybe_end_quotation bp len =
-    parser
-    [ [: `'>' :] -> len
-    | [: a = quotation bp (store len '>') :] -> a ]
-  and left_paren bp =
-    parser
-    [ [: `'*'; _ = comment bp; a = next_token True :] -> a
-    | [: :] ep -> keyword_or_error (bp, ep) "(" ]
-  and comment bp =
-    parser
-    [ [: `'('; s :] -> left_paren_in_comment bp s
-    | [: `'*'; s :] -> star_in_comment bp s
-    | [: `'"'; _ = string bp 0; s :] -> comment bp s
-    | [: `'''; s :] -> quote_in_comment bp s
-    | [: `c; s :] -> comment bp s
-    | [: :] ep -> err (bp, ep) "comment not terminated" ]
-  and quote_in_comment bp =
-    parser
-    [ [: `'''; s :] -> comment bp s
-    | [: `'\013'; s :] -> quote_cr_in_comment bp s
-    | [: `'\\'; s :] -> quote_antislash_in_comment bp s
-    | [: `'('; s :] -> quote_left_paren_in_comment bp s
-    | [: `'*'; s :] -> quote_star_in_comment bp s
-    | [: `'"'; s :] -> quote_doublequote_in_comment bp s
-    | [: `_; s :] -> quote_any_in_comment bp s
-    | [: s :] -> comment bp s ]
-  and quote_any_in_comment bp =
-    parser
-    [ [: `'''; s :] -> comment bp s
-    | [: s :] -> comment bp s ]
-  and quote_cr_in_comment bp =
-    parser
-    [ [: `'\010'; s :] -> quote_any_in_comment bp s
-    | [: s :] -> quote_any_in_comment bp s ]
-  and quote_left_paren_in_comment bp =
-    parser
-    [ [: `'''; s :] -> comment bp s
-    | [: s :] -> left_paren_in_comment bp s ]
-  and quote_star_in_comment bp =
-    parser
-    [ [: `'''; s :] -> comment bp s
-    | [: s :] -> star_in_comment bp s ]
-  and quote_doublequote_in_comment bp =
-    parser
-    [ [: `'''; s :] -> comment bp s
-    | [: _ = string bp 0; s :] -> comment bp s ]
-  and quote_antislash_in_comment bp =
-    parser
-    [ [: `'''; s :] -> quote_antislash_quote_in_comment bp s
-    | [: `('\\' | '"' | 'n' | 't' | 'b' | 'r'); s :] ->
-        quote_any_in_comment bp s
-    | [: `('0'..'9'); s :] -> quote_antislash_digit_in_comment bp s
-    | [: `'x'; s :] -> quote_antislash_x_in_comment bp s
-    | [: s :] -> comment bp s ]
-  and quote_antislash_quote_in_comment bp =
-    parser
-    [ [: `'''; s :] -> comment bp s
-    | [: s :] -> quote_in_comment bp s ]
-  and quote_antislash_digit_in_comment bp =
-    parser
-    [ [: `('0'..'9'); s :] -> quote_antislash_digit2_in_comment bp s
-    | [: s :] -> comment bp s ]
-  and quote_antislash_digit2_in_comment bp =
-    parser
-    [ [: `('0'..'9'); s :] -> quote_any_in_comment bp s
-    | [: s :] -> comment bp s ]
-  and quote_antislash_x_in_comment bp =
-    parser
-    [ [: _ = hexa; s :] -> quote_antislash_x_digit_in_comment bp s
-    | [: s :] -> comment bp s ]
-  and quote_antislash_x_digit_in_comment bp =
-    parser
-    [ [: _ = hexa; s :] -> quote_any_in_comment bp s
-    | [: s :] -> comment bp s ]
-  and left_paren_in_comment bp =
-    parser
-    [ [: `'*'; s :] -> do { comment bp s; comment bp s }
-    | [: a = comment bp :] -> a ]
-  and star_in_comment bp =
-    parser
-    [ [: `')' :] -> ()
-    | [: a = comment bp :] -> a ]
-  and linedir n s =
-    match stream_peek_nth n s with
-    [ Some (' ' | '\t') -> linedir (n + 1) s
-    | Some ('0'..'9') -> linedir_digits (n + 1) s
-    | _ -> False ]
-  and linedir_digits n s =
-    match stream_peek_nth n s with
-    [ Some ('0'..'9') -> linedir_digits (n + 1) s
-    | _ -> linedir_quote n s ]
-  and linedir_quote n s =
-    match stream_peek_nth n s with
-    [ Some (' ' | '\t') -> linedir_quote (n + 1) s
-    | Some '"' -> True
-    | _ -> False ]
-  and any_to_nl =
-    parser
-    [ [: `'\013' | '\010' :] ep -> bolpos.val := ep
-    | [: `_; s :] -> any_to_nl s
-    | [: :] -> () ]
+(* Debugging positions and locations *)
+let eprint_pos msg p =
+  Printf.eprintf "%s: fname=%s; lnum=%d; bol=%d; cnum=%d\n%!" msg
+    p.Lexing.pos_fname p.Lexing.pos_lnum p.Lexing.pos_bol p.Lexing.pos_cnum
+;;
+
+let eprint_loc (bp, ep) = eprint_pos "P1" bp; eprint_pos "P2" ep;;
+   
+let check_location msg (bp, ep as loc) =
+  let ok =
+    if bp.Lexing.pos_lnum > ep.Lexing.pos_lnum ||
+       bp.Lexing.pos_bol > ep.Lexing.pos_bol ||
+       bp.Lexing.pos_cnum > ep.Lexing.pos_cnum || bp.Lexing.pos_lnum < 0 ||
+       ep.Lexing.pos_lnum < 0 || bp.Lexing.pos_bol < 0 ||
+       ep.Lexing.pos_bol < 0 || bp.Lexing.pos_cnum < 0 ||
+       ep.Lexing.pos_cnum < 0
+    then
+      begin
+        Printf.eprintf "*** Warning: (%s) strange positions ***\n" msg;
+        eprint_loc loc;
+        false
+      end
+    else true
   in
-  fun cstrm ->
-    try
-      let glex = glexr.val in
-      let comm_bp = Stream.count cstrm in
-      let r = next_token False cstrm in
-      do {
-        match glex.tok_comm with
-        [ Some list ->
-            if fst (snd r) > comm_bp then
-              let comm_loc = (comm_bp, fst (snd r)) in
-              glex.tok_comm := Some [comm_loc :: list]
-            else ()
-        | None -> () ];
-        r
-      }
-    with
-    [ Stream.Error str ->
-        err (Stream.count cstrm, Stream.count cstrm + 1) str ]
-;
-*)
+  ok, loc
+;;
 
-let next_token_fun dfa ssd find_kwd bolpos glexr =
-  let keyword_or_error loc s =
+let next_token_fun dfa ssd find_kwd fname lnum bolpos glexr =
+  let make_pos p =
+    {Lexing.pos_fname = !fname; Lexing.pos_lnum = !lnum;
+     Lexing.pos_bol = !bolpos; Lexing.pos_cnum = p}
+  in
+  let mkloc (bp, ep) = make_pos bp, make_pos ep in
+  let keyword_or_error (bp, ep) s =
+    let loc = mkloc (bp, ep) in
     try ("", find_kwd s), loc with
       Not_found ->
         if !error_on_unknown_keywords then err loc ("illegal token: " ^ s)
         else ("", s), loc
   in
-  let error_if_keyword ((_, id), loc as a) =
+  let error_if_keyword ((_, id as a), bep) =
+    let loc = mkloc bep in
     try
       ignore (find_kwd id);
       err loc ("illegal use of a keyword as a label: " ^ id)
     with
-      Not_found -> a
+      Not_found -> a, loc
   in
   let rec next_token after_space (strm__ : _ Stream.t) =
     let bp = Stream.count strm__ in
     match Stream.peek strm__ with
-      Some ('\010' | '\013') ->
+      Some '\010' ->
+        Stream.junk strm__;
+        let s = strm__ in
+        let ep = Stream.count strm__ in
+        bolpos := ep; incr lnum; next_token true s
+    | Some '\013' ->
         Stream.junk strm__;
         let s = strm__ in
-        let ep = Stream.count strm__ in bolpos := ep; next_token true s
+        let ep = Stream.count strm__ in
+        let ep =
+          match Stream.peek s with
+            Some '\010' -> Stream.junk s; ep + 1
+          | _ -> ep
+        in
+        bolpos := ep; incr lnum; next_token true s
     | Some (' ' | '\t' | '\026' | '\012') ->
         Stream.junk strm__; next_token true strm__
     | Some '#' when bp = !bolpos ->
         Stream.junk strm__;
         let s = strm__ in
-        if linedir 1 s then begin any_to_nl s; next_token true s end
+        if linedir 1 s then begin line_directive s; next_token true s end
         else keyword_or_error (bp, bp + 1) "#"
     | Some '(' -> Stream.junk strm__; left_paren bp strm__
     | Some ('A'..'Z' | '\192'..'\214' | '\216'..'\222' as c) ->
         Stream.junk strm__;
         let s = strm__ in
         let id = get_buff (ident (store 0 c) s) in
-        let loc = bp, Stream.count s in
+        let loc = mkloc (bp, Stream.count s) in
         (try "", find_kwd id with
            Not_found -> "UIDENT", id),
         loc
@@ -517,35 +234,35 @@ let next_token_fun dfa ssd find_kwd bolpos glexr =
         Stream.junk strm__;
         let s = strm__ in
         let id = get_buff (ident (store 0 c) s) in
-        let loc = bp, Stream.count s in
+        let loc = mkloc (bp, Stream.count s) in
         (try "", find_kwd id with
            Not_found -> "LIDENT", id),
         loc
     | Some ('1'..'9' as c) ->
         Stream.junk strm__;
         let tok = number (store 0 c) strm__ in
-        let loc = bp, Stream.count strm__ in tok, loc
+        let loc = mkloc (bp, Stream.count strm__) in tok, loc
     | Some '0' ->
         Stream.junk strm__;
         let tok = base_number (store 0 '0') strm__ in
-        let loc = bp, Stream.count strm__ in tok, loc
+        let loc = mkloc (bp, Stream.count strm__) in tok, loc
     | Some '\'' ->
         Stream.junk strm__;
         let s = strm__ in
         begin match Stream.npeek 2 s with
           [_; '\''] | ['\\'; _] ->
             let tok = "CHAR", get_buff (char bp 0 s) in
-            let loc = bp, Stream.count s in tok, loc
+            let loc = mkloc (bp, Stream.count s) in tok, loc
         | _ -> keyword_or_error (bp, Stream.count s) "'"
         end
     | Some '\"' ->
         Stream.junk strm__;
         let tok = "STRING", get_buff (string bp 0 strm__) in
-        let loc = bp, Stream.count strm__ in tok, loc
+        let loc = mkloc (bp, Stream.count strm__) in tok, loc
     | Some '$' ->
         Stream.junk strm__;
         let tok = dollar bp 0 strm__ in
-        let loc = bp, Stream.count strm__ in tok, loc
+        let loc = mkloc (bp, Stream.count strm__) in tok, loc
     | Some ('!' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | '%' as c) ->
         Stream.junk strm__;
         let id = get_buff (ident2 (store 0 c) strm__) in
@@ -671,12 +388,12 @@ let next_token_fun dfa ssd find_kwd bolpos glexr =
     | Some '\\' ->
         Stream.junk strm__;
         let ep = Stream.count strm__ in
-        ("LIDENT", get_buff (ident3 0 strm__)), (bp, ep)
+        ("LIDENT", get_buff (ident3 0 strm__)), mkloc (bp, ep)
     | Some c ->
         Stream.junk strm__;
         let ep = Stream.count strm__ in
         keyword_or_error (bp, ep) (String.make 1 c)
-    | _ -> let _ = Stream.empty strm__ in ("EOI", ""), (bp, succ bp)
+    | _ -> let _ = Stream.empty strm__ in ("EOI", ""), mkloc (bp, succ bp)
   and less bp strm =
     if !no_quotations then
       let (strm__ : _ Stream.t) = strm in
@@ -693,7 +410,7 @@ let next_token_fun dfa ssd find_kwd bolpos glexr =
               Stream.Failure -> raise (Stream.Error "")
           in
           let ep = Stream.count strm__ in
-          ("QUOTATION", ":" ^ get_buff len), (bp, ep)
+          ("QUOTATION", ":" ^ get_buff len), mkloc (bp, ep)
       | Some ':' ->
           Stream.junk strm__;
           let i =
@@ -708,7 +425,7 @@ let next_token_fun dfa ssd find_kwd bolpos glexr =
                   Stream.Failure -> raise (Stream.Error "")
               in
               let ep = Stream.count strm__ in
-              ("QUOTATION", i ^ ":" ^ get_buff len), (bp, ep)
+              ("QUOTATION", i ^ ":" ^ get_buff len), mkloc (bp, ep)
           | _ -> raise (Stream.Error "character '<' expected")
           end
       | _ ->
@@ -727,9 +444,26 @@ let next_token_fun dfa ssd find_kwd bolpos glexr =
             string bp (store (store len '\\') c) strm__
         | _ -> raise (Stream.Error "")
         end
+    | Some '\010' ->
+        Stream.junk strm__;
+        let s = strm__ in
+        let ep = Stream.count strm__ in
+        bolpos := ep; incr lnum; string bp len s
+    | Some '\013' ->
+        Stream.junk strm__;
+        let s = strm__ in
+        let ep = Stream.count strm__ in
+        let (len, ep) =
+          match Stream.peek s with
+            Some '\010' ->
+              Stream.junk s; store (store len '\013') '\010', ep + 1
+          | _ -> store len '\013', ep
+        in
+        bolpos := ep; incr lnum; string bp len s
     | Some c -> Stream.junk strm__; string bp (store len c) strm__
     | _ ->
-        let ep = Stream.count strm__ in err (bp, ep) "string not terminated"
+        let ep = Stream.count strm__ in
+        err (mkloc (bp, ep)) "string not terminated"
   and char bp len (strm__ : _ Stream.t) =
     match Stream.peek strm__ with
       Some '\'' ->
@@ -742,8 +476,23 @@ let next_token_fun dfa ssd find_kwd bolpos glexr =
             Stream.junk strm__; char bp (store (store len '\\') c) strm__
         | _ -> raise (Stream.Error "")
         end
+    | Some '\010' ->
+        Stream.junk strm__;
+        let s = strm__ in
+        bolpos := bp + 1; incr lnum; char bp (store len '\010') s
+    | Some '\013' ->
+        Stream.junk strm__;
+        let s = strm__ in
+        let bol =
+          match Stream.peek s with
+            Some '\010' -> Stream.junk s; bp + 2
+          | _ -> bp + 1
+        in
+        bolpos := bol; incr lnum; char bp (store len '\013') s
     | Some c -> Stream.junk strm__; char bp (store len c) strm__
-    | _ -> let ep = Stream.count strm__ in err (bp, ep) "char not terminated"
+    | _ ->
+        let ep = Stream.count strm__ in
+        err (mkloc (bp, ep)) "char not terminated"
   and dollar bp len (strm__ : _ Stream.t) =
     match Stream.peek strm__ with
       Some '$' -> Stream.junk strm__; "ANTIQUOT", ":" ^ get_buff len
@@ -773,7 +522,7 @@ let next_token_fun dfa ssd find_kwd bolpos glexr =
               "ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s
           | _ ->
               let ep = Stream.count strm__ in
-              err (bp, ep) "antiquotation not terminated"
+              err (mkloc (bp, ep)) "antiquotation not terminated"
         else "", get_buff (ident2 (store 0 '$') s)
   and maybe_locate bp len (strm__ : _ Stream.t) =
     match Stream.peek strm__ with
@@ -796,7 +545,7 @@ let next_token_fun dfa ssd find_kwd bolpos glexr =
         "ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) strm__
     | _ ->
         let ep = Stream.count strm__ in
-        err (bp, ep) "antiquotation not terminated"
+        err (mkloc (bp, ep)) "antiquotation not terminated"
   and antiquot bp len (strm__ : _ Stream.t) =
     match Stream.peek strm__ with
       Some '$' -> Stream.junk strm__; "ANTIQUOT", ":" ^ get_buff len
@@ -819,7 +568,7 @@ let next_token_fun dfa ssd find_kwd bolpos glexr =
         "ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) strm__
     | _ ->
         let ep = Stream.count strm__ in
-        err (bp, ep) "antiquotation not terminated"
+        err (mkloc (bp, ep)) "antiquotation not terminated"
   and locate_or_antiquot_rest bp len (strm__ : _ Stream.t) =
     match Stream.peek strm__ with
       Some '$' -> Stream.junk strm__; get_buff len
@@ -835,7 +584,7 @@ let next_token_fun dfa ssd find_kwd bolpos glexr =
         Stream.junk strm__; locate_or_antiquot_rest bp (store len c) strm__
     | _ ->
         let ep = Stream.count strm__ in
-        err (bp, ep) "antiquotation not terminated"
+        err (mkloc (bp, ep)) "antiquotation not terminated"
   and quotation bp len (strm__ : _ Stream.t) =
     match Stream.peek strm__ with
       Some '>' -> Stream.junk strm__; maybe_end_quotation bp len strm__
@@ -856,7 +605,7 @@ let next_token_fun dfa ssd find_kwd bolpos glexr =
     | Some c -> Stream.junk strm__; quotation bp (store len c) strm__
     | _ ->
         let ep = Stream.count strm__ in
-        err (bp, ep) "quotation not terminated"
+        err (mkloc (bp, ep)) "quotation not terminated"
   and maybe_nested_quotation bp len (strm__ : _ Stream.t) =
     match Stream.peek strm__ with
       Some '<' ->
@@ -905,9 +654,24 @@ let next_token_fun dfa ssd find_kwd bolpos glexr =
         in
         comment bp strm__
     | Some '\'' -> Stream.junk strm__; quote_in_comment bp strm__
+    | Some '\010' ->
+        Stream.junk strm__;
+        let s = strm__ in
+        let ep = Stream.count strm__ in bolpos := ep; incr lnum; comment bp s
+    | Some '\013' ->
+        Stream.junk strm__;
+        let s = strm__ in
+        let ep = Stream.count strm__ in
+        let ep =
+          match Stream.peek s with
+            Some '\010' -> Stream.junk s; ep + 1
+          | _ -> ep
+        in
+        bolpos := ep; incr lnum; comment bp s
     | Some c -> Stream.junk strm__; comment bp strm__
     | _ ->
-        let ep = Stream.count strm__ in err (bp, ep) "comment not terminated"
+        let ep = Stream.count strm__ in
+        err (mkloc (bp, ep)) "comment not terminated"
   and quote_in_comment bp (strm__ : _ Stream.t) =
     match Stream.peek strm__ with
       Some '\'' -> Stream.junk strm__; comment bp strm__
@@ -915,7 +679,19 @@ let next_token_fun dfa ssd find_kwd bolpos glexr =
     | _ ->
         let s = strm__ in
         begin match Stream.npeek 2 s with
-          [_; '\''] -> Stream.junk s; Stream.junk s
+          ['\013' | '\010'; '\''] ->
+            bolpos := bp + 1; incr lnum; Stream.junk s; Stream.junk s
+        | ['\013'; '\010'] ->
+            begin match Stream.npeek 3 s with
+              [_; _; '\''] ->
+                bolpos := bp + 2;
+                incr lnum;
+                Stream.junk s;
+                Stream.junk s;
+                Stream.junk s
+            | _ -> ()
+            end
+        | [_; '\''] -> Stream.junk s; Stream.junk s
         | _ -> ()
         end;
         comment bp s
@@ -952,23 +728,73 @@ let next_token_fun dfa ssd find_kwd bolpos glexr =
   and linedir n s =
     match stream_peek_nth n s with
       Some (' ' | '\t') -> linedir (n + 1) s
-    | Some ('0'..'9') -> linedir_digits (n + 1) s
-    | _ -> false
-  and linedir_digits n s =
-    match stream_peek_nth n s with
-      Some ('0'..'9') -> linedir_digits (n + 1) s
-    | _ -> linedir_quote n s
-  and linedir_quote n s =
-    match stream_peek_nth n s with
-      Some (' ' | '\t') -> linedir_quote (n + 1) s
-    | Some '\"' -> true
+    | Some ('0'..'9') -> true
     | _ -> false
   and any_to_nl (strm__ : _ Stream.t) =
     match Stream.peek strm__ with
-      Some ('\013' | '\010') ->
-        Stream.junk strm__; let ep = Stream.count strm__ in bolpos := ep
+      Some '\010' ->
+        Stream.junk strm__;
+        let s = strm__ in
+        let ep = Stream.count strm__ in bolpos := ep; incr lnum
+    | Some '\013' ->
+        Stream.junk strm__;
+        let s = strm__ in
+        let ep = Stream.count strm__ in
+        let ep =
+          match Stream.peek s with
+            Some '\010' -> Stream.junk s; ep + 1
+          | _ -> ep
+        in
+        bolpos := ep; incr lnum
     | Some _ -> Stream.junk strm__; any_to_nl strm__
     | _ -> ()
+  and line_directive (strm__ : _ Stream.t) =
+    let _ = skip_spaces strm__ in
+    let n =
+      try line_directive_number 0 strm__ with
+        Stream.Failure -> raise (Stream.Error "")
+    in
+    let _ =
+      try skip_spaces strm__ with
+        Stream.Failure -> raise (Stream.Error "")
+    in
+    let _ =
+      try line_directive_string strm__ with
+        Stream.Failure -> raise (Stream.Error "")
+    in
+    let _ =
+      try any_to_nl strm__ with
+        Stream.Failure -> raise (Stream.Error "")
+    in
+    let ep = Stream.count strm__ in bolpos := ep; lnum := n
+  and skip_spaces (strm__ : _ Stream.t) =
+    match Stream.peek strm__ with
+      Some (' ' | '\t') -> Stream.junk strm__; skip_spaces strm__
+    | _ -> ()
+  and line_directive_number n (strm__ : _ Stream.t) =
+    match Stream.peek strm__ with
+      Some ('0'..'9' as c) ->
+        Stream.junk strm__;
+        line_directive_number (10 * n + (Char.code c - Char.code '0')) strm__
+    | _ -> n
+  and line_directive_string (strm__ : _ Stream.t) =
+    match Stream.peek strm__ with
+      Some '\"' ->
+        Stream.junk strm__;
+        let _ =
+          try line_directive_string_contents 0 strm__ with
+            Stream.Failure -> raise (Stream.Error "")
+        in
+        ()
+    | _ -> ()
+  and line_directive_string_contents len (strm__ : _ Stream.t) =
+    match Stream.peek strm__ with
+      Some ('\010' | '\013') -> Stream.junk strm__; ()
+    | Some '\"' -> Stream.junk strm__; fname := get_buff len
+    | Some c ->
+        Stream.junk strm__;
+        line_directive_string_contents (store len c) strm__
+    | _ -> raise Stream.Failure
   in
   fun cstrm ->
     try
@@ -977,14 +803,16 @@ let next_token_fun dfa ssd find_kwd bolpos glexr =
       let r = next_token false cstrm in
       begin match glex.tok_comm with
         Some list ->
-          if fst (snd r) > comm_bp then
-            let comm_loc = comm_bp, fst (snd r) in
+          let next_bp = (fst (snd r)).Lexing.pos_cnum in
+          if next_bp > comm_bp then
+            let comm_loc = mkloc (comm_bp, next_bp) in
             glex.tok_comm <- Some (comm_loc :: list)
       | None -> ()
       end;
       r
     with
-      Stream.Error str -> err (Stream.count cstrm, Stream.count cstrm + 1) str
+      Stream.Error str ->
+        err (mkloc (Stream.count cstrm, Stream.count cstrm + 1)) str
 ;;
 
 
@@ -993,10 +821,13 @@ let specific_space_dot = ref false;;
 
 let func kwd_table glexr =
   let bolpos = ref 0 in
+  let lnum = ref 1 in
+  let fname = ref "" in
   let find = Hashtbl.find kwd_table in
   let dfa = !dollar_for_antiquotation in
   let ssd = !specific_space_dot in
-  Token.lexer_func_of_parser (next_token_fun dfa ssd find bolpos glexr)
+  Token.lexer_func_of_parser
+    (next_token_fun dfa ssd find fname lnum bolpos glexr)
 ;;
 
 let rec check_keyword_stream (strm__ : _ Stream.t) =
@@ -1211,11 +1042,11 @@ let gmake () =
   let id_table = Hashtbl.create 301 in
   let glexr =
     ref
-      {tok_func = (fun _ -> raise (Match_failure ("plexer.ml", 972, 17)));
-       tok_using = (fun _ -> raise (Match_failure ("plexer.ml", 972, 37)));
-       tok_removing = (fun _ -> raise (Match_failure ("plexer.ml", 972, 60)));
-       tok_match = (fun _ -> raise (Match_failure ("plexer.ml", 973, 18)));
-       tok_text = (fun _ -> raise (Match_failure ("plexer.ml", 973, 37)));
+      {tok_func = (fun _ -> raise (Match_failure ("", 741, 17)));
+       tok_using = (fun _ -> raise (Match_failure ("", 741, 37)));
+       tok_removing = (fun _ -> raise (Match_failure ("", 741, 60)));
+       tok_match = (fun _ -> raise (Match_failure ("", 742, 18)));
+       tok_text = (fun _ -> raise (Match_failure ("", 742, 37)));
        tok_comm = None}
   in
   let glex =
@@ -1245,12 +1076,11 @@ let make () =
   let id_table = Hashtbl.create 301 in
   let glexr =
     ref
-      {tok_func = (fun _ -> raise (Match_failure ("plexer.ml", 1001, 17)));
-       tok_using = (fun _ -> raise (Match_failure ("plexer.ml", 1001, 37)));
-       tok_removing =
-         (fun _ -> raise (Match_failure ("plexer.ml", 1001, 60)));
-       tok_match = (fun _ -> raise (Match_failure ("plexer.ml", 1002, 18)));
-       tok_text = (fun _ -> raise (Match_failure ("plexer.ml", 1002, 37)));
+      {tok_func = (fun _ -> raise (Match_failure ("", 770, 17)));
+       tok_using = (fun _ -> raise (Match_failure ("", 770, 37)));
+       tok_removing = (fun _ -> raise (Match_failure ("", 770, 60)));
+       tok_match = (fun _ -> raise (Match_failure ("", 771, 18)));
+       tok_text = (fun _ -> raise (Match_failure ("", 771, 37)));
        tok_comm = None}
   in
   {func = func kwd_table glexr; using = using_token kwd_table id_table;
diff --git a/camlp4/ocaml_src/lib/stdpp.ml b/camlp4/ocaml_src/lib/stdpp.ml
index d91ee78c07..ab80b24a99 100644
--- a/camlp4/ocaml_src/lib/stdpp.ml
+++ b/camlp4/ocaml_src/lib/stdpp.ml
@@ -12,7 +12,7 @@
 
 (* This file has been generated by program: do not edit! *)
 
-exception Exc_located of (int * int) * exn;;
+exception Exc_located of Token.flocation * exn;;
 
 let raise_with_loc loc exc =
   match exc with
@@ -21,79 +21,67 @@ let raise_with_loc loc exc =
 ;;
 
 let line_of_loc fname (bp, ep) =
+  bp.Lexing.pos_fname, bp.Lexing.pos_lnum,
+  bp.Lexing.pos_cnum - bp.Lexing.pos_bol,
+  ep.Lexing.pos_cnum - bp.Lexing.pos_bol
+;;
+
+(*
+value line_of_loc fname (bp, ep) =
   try
     let ic = open_in_bin fname in
     let strm = Stream.of_channel ic in
     let rec loop fname lin =
-      let rec not_a_line_dir col (strm__ : _ Stream.t) =
-        let cnt = Stream.count strm__ in
-        match Stream.peek strm__ with
-          Some c ->
-            Stream.junk strm__;
-            let s = strm__ in
+      let rec not_a_line_dir col =
+        parser cnt
+          [: `c; s :] ->
             if cnt < bp then
               if c = '\n' then loop fname (lin + 1)
               else not_a_line_dir (col + 1) s
-            else let col = col - (cnt - bp) in fname, lin, col, col + ep - bp
-        | _ -> raise Stream.Failure
+            else
+              let col = col - (cnt - bp) in
+              (fname, lin, col, col + ep - bp)
       in
-      let rec a_line_dir str n col (strm__ : _ Stream.t) =
-        match Stream.peek strm__ with
-          Some '\n' -> Stream.junk strm__; loop str n
-        | Some _ -> Stream.junk strm__; a_line_dir str n (col + 1) strm__
-        | _ -> raise Stream.Failure
+      let rec a_line_dir str n col =
+        parser
+        [ [: `'\n' :] -> loop str n
+        | [: `_; s :] -> a_line_dir str n (col + 1) s ]
       in
-      let rec spaces col (strm__ : _ Stream.t) =
-        match Stream.peek strm__ with
-          Some ' ' -> Stream.junk strm__; spaces (col + 1) strm__
-        | _ -> col
+      let rec spaces col =
+        parser
+        [ [: `' '; s :] -> spaces (col + 1) s
+        | [: :] -> col ]
       in
-      let rec check_string str n col (strm__ : _ Stream.t) =
-        match Stream.peek strm__ with
-          Some '\"' ->
-            Stream.junk strm__;
-            let col =
-              try spaces (col + 1) strm__ with
-                Stream.Failure -> raise (Stream.Error "")
-            in
-            a_line_dir str n col strm__
-        | Some c when c <> '\n' ->
-            Stream.junk strm__;
-            check_string (str ^ String.make 1 c) n (col + 1) strm__
-        | _ -> not_a_line_dir col strm__
+      let rec check_string str n col =
+        parser
+        [ [: `'"'; col = spaces (col + 1); s :] -> a_line_dir str n col s
+        | [: `c when c <> '\n'; s :] ->
+            check_string (str ^ String.make 1 c) n (col + 1) s
+        | [: a = not_a_line_dir col :] -> a ]
       in
-      let check_quote n col (strm__ : _ Stream.t) =
-        match Stream.peek strm__ with
-          Some '\"' -> Stream.junk strm__; check_string "" n (col + 1) strm__
-        | _ -> not_a_line_dir col strm__
+      let check_quote n col =
+        parser
+        [ [: `'"'; s :] -> check_string "" n (col + 1) s
+        | [: a = not_a_line_dir col :] -> a ]
       in
-      let rec check_num n col (strm__ : _ Stream.t) =
-        match Stream.peek strm__ with
-          Some ('0'..'9' as c) ->
-            Stream.junk strm__;
-            check_num (10 * n + Char.code c - Char.code '0') (col + 1) strm__
-        | _ -> let col = spaces col strm__ in check_quote n col strm__
+      let rec check_num n col =
+        parser
+        [ [: `('0'..'9' as c); s :] ->
+            check_num (10 * n + Char.code c - Char.code '0') (col + 1) s
+        | [: col = spaces col; s :] -> check_quote n col s ]
       in
-      let begin_line (strm__ : _ Stream.t) =
-        match Stream.peek strm__ with
-          Some '#' ->
-            Stream.junk strm__;
-            let col =
-              try spaces 1 strm__ with
-                Stream.Failure -> raise (Stream.Error "")
-            in
-            check_num 0 col strm__
-        | _ -> not_a_line_dir 0 strm__
+      let begin_line =
+        parser
+        [ [: `'#'; col = spaces 1; s :] -> check_num 0 col s
+        | [: a = not_a_line_dir 0 :] -> a ]
       in
       begin_line strm
     in
-    let r =
-      try loop fname 1 with
-        Stream.Failure -> fname, 1, bp, ep
-    in
-    close_in ic; r
+    let r = try loop fname 1 with [ Stream.Failure -> (fname, 1, bp, ep) ] in
+    do { close_in ic; r }
   with
-    Sys_error _ -> fname, 1, bp, ep
-;;
+  [ Sys_error _ -> (fname, 1, bp, ep) ]
+;
+*)
 
 let loc_name = ref "loc";;
diff --git a/camlp4/ocaml_src/lib/stdpp.mli b/camlp4/ocaml_src/lib/stdpp.mli
index 68c0cb6ada..e966ee9aa2 100644
--- a/camlp4/ocaml_src/lib/stdpp.mli
+++ b/camlp4/ocaml_src/lib/stdpp.mli
@@ -14,18 +14,18 @@
 
 (** Standard definitions. *)
 
-exception Exc_located of (int * int) * exn;;
+exception Exc_located of Token.flocation * exn;;
    (** [Exc_located loc e] is an encapsulation of the exception [e] with
        the input location [loc]. To be used in quotation expanders
        and in grammars to specify some input location for an error.
        Do not raise this exception directly: rather use the following
        function [raise_with_loc]. *)
 
-val raise_with_loc : int * int -> exn -> 'a;;
+val raise_with_loc : Token.flocation -> exn -> 'a;;
    (** [raise_with_loc loc e], if [e] is already the exception [Exc_located],
        re-raise it, else raise the exception [Exc_located loc e]. *)
 
-val line_of_loc : string -> int * int -> string * int * int * int;;
+val line_of_loc : string -> Token.flocation -> string * int * int * int;;
    (** [line_of_loc fname loc] reads the file [fname] up to the
        location [loc] and returns the real input file, the line number
        and the characters location in the line; the real input file
diff --git a/camlp4/ocaml_src/lib/token.ml b/camlp4/ocaml_src/lib/token.ml
index bc8faeac3e..9eea60aa62 100644
--- a/camlp4/ocaml_src/lib/token.ml
+++ b/camlp4/ocaml_src/lib/token.ml
@@ -17,9 +17,22 @@ type pattern = string * string;;
 
 exception Error of string;;
 
-type location = int * int;;
-type location_function = int -> int * int;;
-type 'te lexer_func = char Stream.t -> 'te Stream.t * location_function;;
+let make_loc (bp, ep) =
+  {(Lexing.dummy_pos) with Lexing.pos_cnum = bp; Lexing.pos_lnum = 1},
+  {(Lexing.dummy_pos) with Lexing.pos_cnum = ep; Lexing.pos_lnum = 1}
+;;
+
+let nowhere = {(Lexing.dummy_pos) with Lexing.pos_cnum = 0};;
+
+let dummy_loc = Lexing.dummy_pos, Lexing.dummy_pos;;
+
+let succ_pos p = {p with Lexing.pos_cnum = p.Lexing.pos_cnum + 1};;
+let lt_pos p1 p2 = p1.Lexing.pos_cnum < p2.Lexing.pos_cnum;;
+
+type flocation = Lexing.position * Lexing.position;;
+
+type flocation_function = int -> flocation;;
+type 'te lexer_func = char Stream.t -> 'te Stream.t * flocation_function;;
 
 type 'te glexer =
   { tok_func : 'te lexer_func;
@@ -27,7 +40,7 @@ type 'te glexer =
     tok_removing : pattern -> unit;
     tok_match : pattern -> 'te -> string;
     tok_text : pattern -> string;
-    mutable tok_comm : location list option }
+    mutable tok_comm : flocation list option }
 ;;
 type lexer =
   { func : t lexer_func;
@@ -43,29 +56,39 @@ let lexer_text (con, prm) =
   else con ^ " '" ^ prm ^ "'"
 ;;
 
-let locerr () = invalid_arg "Lexer: location function";;
-let loct_create () = ref (Array.create 1024 None), ref false;;
+let locerr () = invalid_arg "Lexer: flocation function";;
+
+let tsz = 256;; (* up to 2^29 entries on a 32-bit machine, 2^61 on 64-bit *)
+
+let loct_create () = ref [| |], ref false;;
+
 let loct_func (loct, ov) i =
   match
-    if i < 0 || i >= Array.length !loct then if !ov then Some (0, 0) else None
-    else Array.unsafe_get !loct i
+    if i < 0 || i / tsz >= Array.length !loct then None
+    else if !loct.(i / tsz) = [| |] then
+      if !ov then Some (nowhere, nowhere) else None
+    else Array.unsafe_get (Array.unsafe_get !loct (i / tsz)) (i mod tsz)
   with
     Some loc -> loc
   | _ -> locerr ()
 ;;
+
 let loct_add (loct, ov) i loc =
-  if i >= Array.length !loct then
-    let new_tmax = Array.length !loct * 2 in
+  while i / tsz >= Array.length !loct && not !ov do
+    let new_tmax = Array.length !loct * 2 + 1 in
     if new_tmax < Sys.max_array_length then
-      let new_loct = Array.create new_tmax None in
-      Array.blit !loct 0 new_loct 0 (Array.length !loct);
-      loct := new_loct;
-      !loct.(i) <- Some loc
+      let new_loct = Array.make new_tmax [| |] in
+      Array.blit !loct 0 new_loct 0 (Array.length !loct); loct := new_loct
     else ov := true
-  else !loct.(i) <- Some loc
+  done;
+  if not !ov then
+    begin
+      if !loct.(i / tsz) = [| |] then !loct.(i / tsz) <- Array.make tsz None;
+      !loct.(i / tsz).(i mod tsz) <- Some loc
+    end
 ;;
 
-let make_stream_and_location next_token_loc =
+let make_stream_and_flocation next_token_loc =
   let loct = loct_create () in
   let ts =
     Stream.from
@@ -76,7 +99,7 @@ let make_stream_and_location next_token_loc =
 ;;
 
 let lexer_func_of_parser next_token_loc cs =
-  make_stream_and_location (fun () -> next_token_loc cs)
+  make_stream_and_flocation (fun () -> next_token_loc cs)
 ;;
 
 let lexer_func_of_ocamllex lexfun cs =
@@ -88,9 +111,9 @@ let lexer_func_of_ocamllex lexfun cs =
   in
   let next_token_loc _ =
     let tok = lexfun lb in
-    let loc = Lexing.lexeme_start lb, Lexing.lexeme_end lb in tok, loc
+    let loc = Lexing.lexeme_start_p lb, Lexing.lexeme_end_p lb in tok, loc
   in
-  make_stream_and_location next_token_loc
+  make_stream_and_flocation next_token_loc
 ;;
 
 (* Char and string tokens to real chars and string *)
@@ -201,7 +224,7 @@ let eval_string (bp, ep) s =
                 try let (c, i) = backslash s i in store len c, i with
                   Not_found ->
                     Printf.eprintf "Warning: char %d, Invalid backslash escape in string\n%!"
-                      (bp + i + 1);
+                      (bp.Lexing.pos_cnum + i + 1);
                     store (store len '\\') c, i + 1
         else store len s.[i], i + 1
       in
diff --git a/camlp4/ocaml_src/lib/token.mli b/camlp4/ocaml_src/lib/token.mli
index 9ddb41069b..715170bd8a 100644
--- a/camlp4/ocaml_src/lib/token.mli
+++ b/camlp4/ocaml_src/lib/token.mli
@@ -33,11 +33,19 @@ exception Error of string;;
 
 (** {6 Lexer type} *)
 
-type location = int * int;;
-type location_function = int -> location;;
+type flocation = Lexing.position * Lexing.position;;
+
+val nowhere : Lexing.position;;
+val dummy_loc : flocation;;
+
+val make_loc : int * int -> flocation;;
+val succ_pos : Lexing.position -> Lexing.position;;
+val lt_pos : Lexing.position -> Lexing.position -> bool;;
+
+type flocation_function = int -> flocation;;
   (** The type for a function associating a number of a token in a stream
       (starting from 0) to its source location. *)
-type 'te lexer_func = char Stream.t -> 'te Stream.t * location_function;;
+type 'te lexer_func = char Stream.t -> 'te Stream.t * flocation_function;;
   (** The type for a lexer function. The character stream is the input
       stream to be lexed. The result is a pair of a token stream and
       a location function for this tokens stream. *)
@@ -48,7 +56,7 @@ type 'te glexer =
     tok_removing : pattern -> unit;
     tok_match : pattern -> 'te -> string;
     tok_text : pattern -> string;
-    mutable tok_comm : location list option }
+    mutable tok_comm : flocation list option }
 ;;
    (** The type for a lexer used by Camlp4 grammars.
 -      The field [tok_func] is the main lexer function. See [lexer_func]
@@ -96,14 +104,14 @@ val default_match : pattern -> string * string -> string;;
    as well. *)
 
 val lexer_func_of_parser :
-  (char Stream.t -> 'te * location) -> 'te lexer_func;;
+  (char Stream.t -> 'te * flocation) -> 'te lexer_func;;
    (** A lexer function from a lexer written as a char stream parser
        returning the next token and its location. *)
 val lexer_func_of_ocamllex : (Lexing.lexbuf -> 'te) -> 'te lexer_func;;
    (** A lexer function from a lexer created by [ocamllex] *)
 
-val make_stream_and_location :
-  (unit -> 'te * location) -> 'te Stream.t * location_function;;
+val make_stream_and_flocation :
+  (unit -> 'te * flocation) -> 'te Stream.t * flocation_function;;
    (** General function *)
 
 (** {6 Useful functions} *)
@@ -114,7 +122,7 @@ val eval_char : string -> char;;
        incorrect backslash sequence is found; [Token.eval_char (Char.escaped c)]
        returns [c] *)
 
-val eval_string : location -> string -> string;;
+val eval_string : flocation -> string -> string;;
    (** Convert a string token, where the escape sequences (backslashes)
        remain to be interpreted; issue a warning if an incorrect
        backslash sequence is found;
diff --git a/camlp4/ocaml_src/meta/.depend b/camlp4/ocaml_src/meta/.depend
index 737ea5ec6b..7c8bcbfbea 100644
--- a/camlp4/ocaml_src/meta/.depend
+++ b/camlp4/ocaml_src/meta/.depend
@@ -1,5 +1,5 @@
-pa_extend.cmo: ../camlp4/mLast.cmi ../camlp4/pcaml.cmi 
-pa_extend.cmx: ../camlp4/mLast.cmi ../camlp4/pcaml.cmx 
+pa_extend.cmo: ../camlp4/mLast.cmi ../camlp4/pcaml.cmi ../camlp4/reloc.cmi 
+pa_extend.cmx: ../camlp4/mLast.cmi ../camlp4/pcaml.cmx ../camlp4/reloc.cmx 
 pa_extend_m.cmo: pa_extend.cmo 
 pa_extend_m.cmx: pa_extend.cmx 
 pa_ifdef.cmo: ../camlp4/mLast.cmi ../camlp4/pcaml.cmi 
@@ -12,5 +12,7 @@ pa_rp.cmo: ../camlp4/mLast.cmi ../camlp4/pcaml.cmi
 pa_rp.cmx: ../camlp4/mLast.cmi ../camlp4/pcaml.cmx 
 pr_dump.cmo: ../camlp4/ast2pt.cmi $(OTOP)/utils/config.cmi ../camlp4/pcaml.cmi 
 pr_dump.cmx: ../camlp4/ast2pt.cmx $(OTOP)/utils/config.cmx ../camlp4/pcaml.cmx 
-q_MLast.cmo: ../camlp4/mLast.cmi ../camlp4/pcaml.cmi ../camlp4/quotation.cmi 
-q_MLast.cmx: ../camlp4/mLast.cmi ../camlp4/pcaml.cmx ../camlp4/quotation.cmx 
+q_MLast.cmo: ../camlp4/mLast.cmi ../camlp4/pcaml.cmi ../camlp4/quotation.cmi \
+    ../camlp4/reloc.cmi 
+q_MLast.cmx: ../camlp4/mLast.cmi ../camlp4/pcaml.cmx ../camlp4/quotation.cmx \
+    ../camlp4/reloc.cmx 
diff --git a/camlp4/ocaml_src/meta/Makefile b/camlp4/ocaml_src/meta/Makefile
index 3b01659358..d0b3cd519c 100644
--- a/camlp4/ocaml_src/meta/Makefile
+++ b/camlp4/ocaml_src/meta/Makefile
@@ -49,11 +49,7 @@ install:
 	cp camlp4r$(EXE) "$(BINDIR)/."
 	if test -f camlp4r.opt; then \
 	  cp camlp4r.opt "$(BINDIR)/camlp4r.opt$(EXE)" ;\
-	  for target in $(OBJSX) $(OBJSX:.cmx=.$(O)) ; do \
-	    if test -f $$target; then \
-	      cp $$target "$(LIBDIR)/camlp4/."; \
-	    fi; \
-	  done; \
+	  cp $(OBJSX) $(OBJSX:.cmx=.$(O)) "$(LIBDIR)/camlp4/."; \
 	fi
 
 include .depend
diff --git a/camlp4/ocaml_src/meta/pa_extend.ml b/camlp4/ocaml_src/meta/pa_extend.ml
index d68baf8d59..2258b96250 100644
--- a/camlp4/ocaml_src/meta/pa_extend.ml
+++ b/camlp4/ocaml_src/meta/pa_extend.ml
@@ -22,9 +22,9 @@ Pcaml.add_option "-split_ext" (Arg.Set split_ext)
 Pcaml.add_option "-split_gext" (Arg.Set split_ext)
   "Old name for the option -split_ext.";;
 
-type loc = int * int;;
+type loc = Lexing.position * Lexing.position;;
 
-type 'e name = { expr : 'e; tvar : string; loc : int * int };;
+type 'e name = { expr : 'e; tvar : string; loc : loc };;
 
 type styp =
     STlid of loc * string
@@ -161,7 +161,12 @@ module MetaAction =
       in
       failwith (f ^ ", not impl: " ^ desc)
     ;;
-    let loc = 0, 0;;
+    let loc =
+      let nowhere =
+        {(Lexing.dummy_pos) with Lexing.pos_lnum = 1; Lexing.pos_cnum = 0}
+      in
+      nowhere, nowhere
+    ;;
     let rec mlist mf =
       function
         [] -> MLast.ExUid (loc, "[]")
@@ -181,7 +186,26 @@ module MetaAction =
       | true -> MLast.ExUid (loc, "True")
     ;;
     let mloc =
-      MLast.ExTup (loc, [MLast.ExInt (loc, "0"); MLast.ExInt (loc, "0")])
+      MLast.ExLet
+        (loc, false,
+         [MLast.PaLid (loc, "nowhere"),
+          MLast.ExRec
+            (loc,
+             [MLast.PaAcc
+                (loc, MLast.PaUid (loc, "Lexing"),
+                 MLast.PaLid (loc, "pos_lnum")),
+              MLast.ExInt (loc, "1");
+              MLast.PaAcc
+                (loc, MLast.PaUid (loc, "Lexing"),
+                 MLast.PaLid (loc, "pos_cnum")),
+              MLast.ExInt (loc, "0")],
+             Some
+               (MLast.ExAcc
+                  (loc, MLast.ExUid (loc, "Lexing"),
+                   MLast.ExLid (loc, "dummy_pos"))))],
+         MLast.ExTup
+           (loc,
+            [MLast.ExLid (loc, "nowhere"); MLast.ExLid (loc, "nowhere")]))
     ;;
     let rec mexpr =
       function
@@ -809,7 +833,13 @@ let quotify_action psl act =
     (fun e ps ->
        match ps.pattern with
          Some (MLast.PaTup (_, pl)) ->
-           let loc = 0, 0 in
+           let loc =
+             let nowhere =
+               {(Lexing.dummy_pos) with Lexing.pos_lnum = 1;
+                 Lexing.pos_cnum = 0}
+             in
+             nowhere, nowhere
+           in
            let pname = pname_of_ptuple pl in
            let (pl1, el1) =
              let (l, _) =
@@ -1040,7 +1070,13 @@ let text_of_action loc psl rtvar act tvar =
        [MLast.PaTyc
           (loc, locid,
            MLast.TyTup
-             (loc, [MLast.TyLid (loc, "int"); MLast.TyLid (loc, "int")])),
+             (loc,
+              [MLast.TyAcc
+                 (loc, MLast.TyUid (loc, "Lexing"),
+                  MLast.TyLid (loc, "position"));
+               MLast.TyAcc
+                 (loc, MLast.TyUid (loc, "Lexing"),
+                  MLast.TyLid (loc, "position"))])),
         None, MLast.ExTyc (loc, act, MLast.TyQuo (loc, rtvar))])
   in
   let txt =
@@ -1459,6 +1495,8 @@ let text_of_functorial_extend loc gmod gl el =
   let_in_of_extend loc gmod true gl el args
 ;;
 
+let zero_loc = {(Lexing.dummy_pos) with Lexing.pos_cnum = 0};;
+
 open Pcaml;;
 let symbol = Grammar.Entry.create gram "symbol";;
 let semi_sep =
@@ -1518,26 +1556,34 @@ Grammar.extend
             (gdelete_rule_body : 'gdelete_rule_body Grammar.Entry.e));
        Gramext.Stoken ("", "END")],
       Gramext.action
-        (fun _ (e : 'gdelete_rule_body) _ (loc : int * int) -> (e : 'expr));
+        (fun _ (e : 'gdelete_rule_body) _
+           (loc : Lexing.position * Lexing.position) ->
+           (e : 'expr));
       [Gramext.Stoken ("", "DELETE_RULE");
        Gramext.Snterm
          (Grammar.Entry.obj
             (delete_rule_body : 'delete_rule_body Grammar.Entry.e));
        Gramext.Stoken ("", "END")],
       Gramext.action
-        (fun _ (e : 'delete_rule_body) _ (loc : int * int) -> (e : 'expr));
+        (fun _ (e : 'delete_rule_body) _
+           (loc : Lexing.position * Lexing.position) ->
+           (e : 'expr));
       [Gramext.Stoken ("", "GEXTEND");
        Gramext.Snterm
          (Grammar.Entry.obj (gextend_body : 'gextend_body Grammar.Entry.e));
        Gramext.Stoken ("", "END")],
       Gramext.action
-        (fun _ (e : 'gextend_body) _ (loc : int * int) -> (e : 'expr));
+        (fun _ (e : 'gextend_body) _
+           (loc : Lexing.position * Lexing.position) ->
+           (e : 'expr));
       [Gramext.Stoken ("", "EXTEND");
        Gramext.Snterm
          (Grammar.Entry.obj (extend_body : 'extend_body Grammar.Entry.e));
        Gramext.Stoken ("", "END")],
       Gramext.action
-        (fun _ (e : 'extend_body) _ (loc : int * int) -> (e : 'expr))]];
+        (fun _ (e : 'extend_body) _
+           (loc : Lexing.position * Lexing.position) ->
+           (e : 'expr))]];
     Grammar.Entry.obj (extend_body : 'extend_body Grammar.Entry.e), None,
     [None, None,
      [[Gramext.Snterm
@@ -1552,10 +1598,12 @@ Grammar.extend
               Gramext.Snterm
                 (Grammar.Entry.obj (semi_sep : 'semi_sep Grammar.Entry.e))],
              Gramext.action
-               (fun _ (e : 'entry) (loc : int * int) -> (e : 'e__1))])],
+               (fun _ (e : 'entry)
+                  (loc : Lexing.position * Lexing.position) ->
+                  (e : 'e__1))])],
       Gramext.action
         (fun (el : 'e__1 list) (sl : 'global option) (f : 'efunction)
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (text_of_extend loc "Grammar" sl el f : 'extend_body))]];
     Grammar.Entry.obj (gextend_body : 'gextend_body Grammar.Entry.e), None,
     [None, None,
@@ -1570,10 +1618,12 @@ Grammar.extend
               Gramext.Snterm
                 (Grammar.Entry.obj (semi_sep : 'semi_sep Grammar.Entry.e))],
              Gramext.action
-               (fun _ (e : 'entry) (loc : int * int) -> (e : 'e__2))])],
+               (fun _ (e : 'entry)
+                  (loc : Lexing.position * Lexing.position) ->
+                  (e : 'e__2))])],
       Gramext.action
         (fun (el : 'e__2 list) (sl : 'global option) (g : string)
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (text_of_functorial_extend loc g sl el : 'gextend_body))]];
     Grammar.Entry.obj (delete_rule_body : 'delete_rule_body Grammar.Entry.e),
     None,
@@ -1586,7 +1636,8 @@ Grammar.extend
           Gramext.Snterm
             (Grammar.Entry.obj (semi_sep : 'semi_sep Grammar.Entry.e)))],
       Gramext.action
-        (fun (sl : 'symbol list) _ (n : 'name) (loc : int * int) ->
+        (fun (sl : 'symbol list) _ (n : 'name)
+           (loc : Lexing.position * Lexing.position) ->
            (let (e, b) = expr_of_delete_rule loc "Grammar" n sl in
             MLast.ExApp
               (loc,
@@ -1612,7 +1663,7 @@ Grammar.extend
             (Grammar.Entry.obj (semi_sep : 'semi_sep Grammar.Entry.e)))],
       Gramext.action
         (fun (sl : 'symbol list) _ (n : 'name) (g : string)
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (let (e, b) = expr_of_delete_rule loc g n sl in
             MLast.ExApp
               (loc,
@@ -1628,7 +1679,7 @@ Grammar.extend
     [None, None,
      [[],
       Gramext.action
-        (fun (loc : int * int) ->
+        (fun (loc : Lexing.position * Lexing.position) ->
            (MLast.ExAcc
               (loc, MLast.ExUid (loc, "Grammar"),
                MLast.ExLid (loc, "extend")) :
@@ -1638,7 +1689,8 @@ Grammar.extend
        Gramext.Snterm
          (Grammar.Entry.obj (semi_sep : 'semi_sep Grammar.Entry.e))],
       Gramext.action
-        (fun _ (f : 'qualid) _ _ (loc : int * int) -> (f : 'efunction))]];
+        (fun _ (f : 'qualid) _ _ (loc : Lexing.position * Lexing.position) ->
+           (f : 'efunction))]];
     Grammar.Entry.obj (global : 'global Grammar.Entry.e), None,
     [None, None,
      [[Gramext.Stoken ("UIDENT", "GLOBAL"); Gramext.Stoken ("", ":");
@@ -1647,7 +1699,9 @@ Grammar.extend
        Gramext.Snterm
          (Grammar.Entry.obj (semi_sep : 'semi_sep Grammar.Entry.e))],
       Gramext.action
-        (fun _ (sl : 'name list) _ _ (loc : int * int) -> (sl : 'global))]];
+        (fun _ (sl : 'name list) _ _
+           (loc : Lexing.position * Lexing.position) ->
+           (sl : 'global))]];
     Grammar.Entry.obj (entry : 'entry Grammar.Entry.e), None,
     [None, None,
      [[Gramext.Snterm (Grammar.Entry.obj (name : 'name Grammar.Entry.e));
@@ -1659,14 +1713,14 @@ Grammar.extend
          (Grammar.Entry.obj (level_list : 'level_list Grammar.Entry.e))],
       Gramext.action
         (fun (ll : 'level_list) (pos : 'position option) _ (n : 'name)
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            ({name = n; pos = pos; levels = ll} : 'entry))]];
     Grammar.Entry.obj (position : 'position Grammar.Entry.e), None,
     [None, None,
      [[Gramext.Stoken ("UIDENT", "LEVEL");
        Gramext.Snterm (Grammar.Entry.obj (string : 'string Grammar.Entry.e))],
       Gramext.action
-        (fun (n : 'string) _ (loc : int * int) ->
+        (fun (n : 'string) _ (loc : Lexing.position * Lexing.position) ->
            (MLast.ExApp
               (loc,
                MLast.ExAcc
@@ -1677,7 +1731,7 @@ Grammar.extend
       [Gramext.Stoken ("UIDENT", "AFTER");
        Gramext.Snterm (Grammar.Entry.obj (string : 'string Grammar.Entry.e))],
       Gramext.action
-        (fun (n : 'string) _ (loc : int * int) ->
+        (fun (n : 'string) _ (loc : Lexing.position * Lexing.position) ->
            (MLast.ExApp
               (loc,
                MLast.ExAcc
@@ -1688,7 +1742,7 @@ Grammar.extend
       [Gramext.Stoken ("UIDENT", "BEFORE");
        Gramext.Snterm (Grammar.Entry.obj (string : 'string Grammar.Entry.e))],
       Gramext.action
-        (fun (n : 'string) _ (loc : int * int) ->
+        (fun (n : 'string) _ (loc : Lexing.position * Lexing.position) ->
            (MLast.ExApp
               (loc,
                MLast.ExAcc
@@ -1698,13 +1752,13 @@ Grammar.extend
             'position));
       [Gramext.Stoken ("UIDENT", "LAST")],
       Gramext.action
-        (fun _ (loc : int * int) ->
+        (fun _ (loc : Lexing.position * Lexing.position) ->
            (MLast.ExAcc
               (loc, MLast.ExUid (loc, "Gramext"), MLast.ExUid (loc, "Last")) :
             'position));
       [Gramext.Stoken ("UIDENT", "FIRST")],
       Gramext.action
-        (fun _ (loc : int * int) ->
+        (fun _ (loc : Lexing.position * Lexing.position) ->
            (MLast.ExAcc
               (loc, MLast.ExUid (loc, "Gramext"),
                MLast.ExUid (loc, "First")) :
@@ -1717,7 +1771,8 @@ Grammar.extend
           Gramext.Stoken ("", "|"));
        Gramext.Stoken ("", "]")],
       Gramext.action
-        (fun _ (ll : 'level list) _ (loc : int * int) ->
+        (fun _ (ll : 'level list) _
+           (loc : Lexing.position * Lexing.position) ->
            (ll : 'level_list))]];
     Grammar.Entry.obj (level : 'level Grammar.Entry.e), None,
     [None, None,
@@ -1729,26 +1784,26 @@ Grammar.extend
          (Grammar.Entry.obj (rule_list : 'rule_list Grammar.Entry.e))],
       Gramext.action
         (fun (rules : 'rule_list) (ass : 'assoc option) (lab : string option)
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            ({label = lab; assoc = ass; rules = rules} : 'level))]];
     Grammar.Entry.obj (assoc : 'assoc Grammar.Entry.e), None,
     [None, None,
      [[Gramext.Stoken ("UIDENT", "NONA")],
       Gramext.action
-        (fun _ (loc : int * int) ->
+        (fun _ (loc : Lexing.position * Lexing.position) ->
            (MLast.ExAcc
               (loc, MLast.ExUid (loc, "Gramext"), MLast.ExUid (loc, "NonA")) :
             'assoc));
       [Gramext.Stoken ("UIDENT", "RIGHTA")],
       Gramext.action
-        (fun _ (loc : int * int) ->
+        (fun _ (loc : Lexing.position * Lexing.position) ->
            (MLast.ExAcc
               (loc, MLast.ExUid (loc, "Gramext"),
                MLast.ExUid (loc, "RightA")) :
             'assoc));
       [Gramext.Stoken ("UIDENT", "LEFTA")],
       Gramext.action
-        (fun _ (loc : int * int) ->
+        (fun _ (loc : Lexing.position * Lexing.position) ->
            (MLast.ExAcc
               (loc, MLast.ExUid (loc, "Gramext"),
                MLast.ExUid (loc, "LeftA")) :
@@ -1761,10 +1816,13 @@ Grammar.extend
           Gramext.Stoken ("", "|"));
        Gramext.Stoken ("", "]")],
       Gramext.action
-        (fun _ (rules : 'rule list) _ (loc : int * int) ->
+        (fun _ (rules : 'rule list) _
+           (loc : Lexing.position * Lexing.position) ->
            (retype_rule_list_without_patterns loc rules : 'rule_list));
       [Gramext.Stoken ("", "["); Gramext.Stoken ("", "]")],
-      Gramext.action (fun _ _ (loc : int * int) -> ([] : 'rule_list))]];
+      Gramext.action
+        (fun _ _ (loc : Lexing.position * Lexing.position) ->
+           ([] : 'rule_list))]];
     Grammar.Entry.obj (rule : 'rule Grammar.Entry.e), None,
     [None, None,
      [[Gramext.Slist0sep
@@ -1773,7 +1831,8 @@ Grammar.extend
           Gramext.Snterm
             (Grammar.Entry.obj (semi_sep : 'semi_sep Grammar.Entry.e)))],
       Gramext.action
-        (fun (psl : 'psymbol list) (loc : int * int) ->
+        (fun (psl : 'psymbol list)
+           (loc : Lexing.position * Lexing.position) ->
            ({prod = psl; action = None} : 'rule));
       [Gramext.Slist0sep
          (Gramext.Snterm
@@ -1783,20 +1842,22 @@ Grammar.extend
        Gramext.Stoken ("", "->");
        Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))],
       Gramext.action
-        (fun (act : 'expr) _ (psl : 'psymbol list) (loc : int * int) ->
+        (fun (act : 'expr) _ (psl : 'psymbol list)
+           (loc : Lexing.position * Lexing.position) ->
            ({prod = psl; action = Some act} : 'rule))]];
     Grammar.Entry.obj (psymbol : 'psymbol Grammar.Entry.e), None,
     [None, None,
      [[Gramext.Snterm (Grammar.Entry.obj (symbol : 'symbol Grammar.Entry.e))],
       Gramext.action
-        (fun (s : 'symbol) (loc : int * int) ->
+        (fun (s : 'symbol) (loc : Lexing.position * Lexing.position) ->
            ({pattern = None; symbol = s} : 'psymbol));
       [Gramext.Snterm
          (Grammar.Entry.obj (pattern : 'pattern Grammar.Entry.e));
        Gramext.Stoken ("", "=");
        Gramext.Snterm (Grammar.Entry.obj (symbol : 'symbol Grammar.Entry.e))],
       Gramext.action
-        (fun (s : 'symbol) _ (p : 'pattern) (loc : int * int) ->
+        (fun (s : 'symbol) _ (p : 'pattern)
+           (loc : Lexing.position * Lexing.position) ->
            ({pattern = Some p; symbol = s} : 'psymbol));
       [Gramext.Stoken ("LIDENT", "");
        Gramext.Sopt
@@ -1804,9 +1865,12 @@ Grammar.extend
             [[Gramext.Stoken ("UIDENT", "LEVEL");
               Gramext.Stoken ("STRING", "")],
              Gramext.action
-               (fun (s : string) _ (loc : int * int) -> (s : 'e__3))])],
+               (fun (s : string) _
+                  (loc : Lexing.position * Lexing.position) ->
+                  (s : 'e__3))])],
       Gramext.action
-        (fun (lev : 'e__3 option) (i : string) (loc : int * int) ->
+        (fun (lev : 'e__3 option) (i : string)
+           (loc : Lexing.position * Lexing.position) ->
            (let name = mk_name loc (MLast.ExLid (loc, i)) in
             let text = TXnterm (loc, name, lev) in
             let styp = STquo (loc, i) in
@@ -1816,14 +1880,15 @@ Grammar.extend
       [Gramext.Stoken ("LIDENT", ""); Gramext.Stoken ("", "=");
        Gramext.Snterm (Grammar.Entry.obj (symbol : 'symbol Grammar.Entry.e))],
       Gramext.action
-        (fun (s : 'symbol) _ (p : string) (loc : int * int) ->
+        (fun (s : 'symbol) _ (p : string)
+           (loc : Lexing.position * Lexing.position) ->
            ({pattern = Some (MLast.PaLid (loc, p)); symbol = s} :
             'psymbol))]];
     Grammar.Entry.obj (symbol : 'symbol Grammar.Entry.e), None,
     [Some "top", Some Gramext.NonA,
      [[Gramext.Stoken ("UIDENT", "OPT"); Gramext.Sself],
       Gramext.action
-        (fun (s : 'symbol) _ (loc : int * int) ->
+        (fun (s : 'symbol) _ (loc : Lexing.position * Lexing.position) ->
            (if !quotify then ssopt loc s
             else
               let styp = STapp (loc, STlid (loc, "option"), s.styp) in
@@ -1837,9 +1902,12 @@ Grammar.extend
               Gramext.Snterm
                 (Grammar.Entry.obj (symbol : 'symbol Grammar.Entry.e))],
              Gramext.action
-               (fun (t : 'symbol) _ (loc : int * int) -> (t : 'e__5))])],
+               (fun (t : 'symbol) _
+                  (loc : Lexing.position * Lexing.position) ->
+                  (t : 'e__5))])],
       Gramext.action
-        (fun (sep : 'e__5 option) (s : 'symbol) _ (loc : int * int) ->
+        (fun (sep : 'e__5 option) (s : 'symbol) _
+           (loc : Lexing.position * Lexing.position) ->
            (if !quotify then sslist loc true sep s
             else
               let used =
@@ -1858,9 +1926,12 @@ Grammar.extend
               Gramext.Snterm
                 (Grammar.Entry.obj (symbol : 'symbol Grammar.Entry.e))],
              Gramext.action
-               (fun (t : 'symbol) _ (loc : int * int) -> (t : 'e__4))])],
+               (fun (t : 'symbol) _
+                  (loc : Lexing.position * Lexing.position) ->
+                  (t : 'e__4))])],
       Gramext.action
-        (fun (sep : 'e__4 option) (s : 'symbol) _ (loc : int * int) ->
+        (fun (sep : 'e__4 option) (s : 'symbol) _
+           (loc : Lexing.position * Lexing.position) ->
            (if !quotify then sslist loc false sep s
             else
               let used =
@@ -1875,16 +1946,20 @@ Grammar.extend
      None, None,
      [[Gramext.Stoken ("", "("); Gramext.Sself; Gramext.Stoken ("", ")")],
       Gramext.action
-        (fun _ (s_t : 'symbol) _ (loc : int * int) -> (s_t : 'symbol));
+        (fun _ (s_t : 'symbol) _ (loc : Lexing.position * Lexing.position) ->
+           (s_t : 'symbol));
       [Gramext.Snterm (Grammar.Entry.obj (name : 'name Grammar.Entry.e));
        Gramext.Sopt
          (Gramext.srules
             [[Gramext.Stoken ("UIDENT", "LEVEL");
               Gramext.Stoken ("STRING", "")],
              Gramext.action
-               (fun (s : string) _ (loc : int * int) -> (s : 'e__7))])],
+               (fun (s : string) _
+                  (loc : Lexing.position * Lexing.position) ->
+                  (s : 'e__7))])],
       Gramext.action
-        (fun (lev : 'e__7 option) (n : 'name) (loc : int * int) ->
+        (fun (lev : 'e__7 option) (n : 'name)
+           (loc : Lexing.position * Lexing.position) ->
            ({used = [n.tvar]; text = TXnterm (loc, n, lev);
              styp = STquo (loc, n.tvar)} :
             'symbol));
@@ -1895,10 +1970,12 @@ Grammar.extend
             [[Gramext.Stoken ("UIDENT", "LEVEL");
               Gramext.Stoken ("STRING", "")],
              Gramext.action
-               (fun (s : string) _ (loc : int * int) -> (s : 'e__6))])],
+               (fun (s : string) _
+                  (loc : Lexing.position * Lexing.position) ->
+                  (s : 'e__6))])],
       Gramext.action
         (fun (lev : 'e__6 option) (e : 'qualid) _ (i : string)
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (let n =
               mk_name loc (MLast.ExAcc (loc, MLast.ExUid (loc, i), e))
             in
@@ -1907,20 +1984,21 @@ Grammar.extend
             'symbol));
       [Gramext.Snterm (Grammar.Entry.obj (string : 'string Grammar.Entry.e))],
       Gramext.action
-        (fun (e : 'string) (loc : int * int) ->
+        (fun (e : 'string) (loc : Lexing.position * Lexing.position) ->
            (let text = TXtok (loc, "", e) in
             {used = []; text = text; styp = STlid (loc, "string")} :
             'symbol));
       [Gramext.Stoken ("UIDENT", "");
        Gramext.Snterm (Grammar.Entry.obj (string : 'string Grammar.Entry.e))],
       Gramext.action
-        (fun (e : 'string) (x : string) (loc : int * int) ->
+        (fun (e : 'string) (x : string)
+           (loc : Lexing.position * Lexing.position) ->
            (let text = TXtok (loc, x, e) in
             {used = []; text = text; styp = STlid (loc, "string")} :
             'symbol));
       [Gramext.Stoken ("UIDENT", "")],
       Gramext.action
-        (fun (x : string) (loc : int * int) ->
+        (fun (x : string) (loc : Lexing.position * Lexing.position) ->
            (let text =
               if !quotify then sstoken loc x
               else TXtok (loc, x, MLast.ExStr (loc, ""))
@@ -1933,7 +2011,8 @@ Grammar.extend
           Gramext.Stoken ("", "|"));
        Gramext.Stoken ("", "]")],
       Gramext.action
-        (fun _ (rl : 'rule list) _ (loc : int * int) ->
+        (fun _ (rl : 'rule list) _
+           (loc : Lexing.position * Lexing.position) ->
            (let rl = retype_rule_list_without_patterns loc rl in
             let t = new_type_var () in
             {used = used_of_rule_list rl;
@@ -1942,12 +2021,12 @@ Grammar.extend
             'symbol));
       [Gramext.Stoken ("UIDENT", "NEXT")],
       Gramext.action
-        (fun _ (loc : int * int) ->
+        (fun _ (loc : Lexing.position * Lexing.position) ->
            ({used = []; text = TXnext loc; styp = STself (loc, "NEXT")} :
             'symbol));
       [Gramext.Stoken ("UIDENT", "SELF")],
       Gramext.action
-        (fun _ (loc : int * int) ->
+        (fun _ (loc : Lexing.position * Lexing.position) ->
            ({used = []; text = TXself loc; styp = STself (loc, "SELF")} :
             'symbol))]];
     Grammar.Entry.obj (pattern : 'pattern Grammar.Entry.e), None,
@@ -1958,17 +2037,20 @@ Grammar.extend
             (patterns_comma : 'patterns_comma Grammar.Entry.e));
        Gramext.Stoken ("", ")")],
       Gramext.action
-        (fun _ (pl : 'patterns_comma) _ (p : 'pattern) _ (loc : int * int) ->
+        (fun _ (pl : 'patterns_comma) _ (p : 'pattern) _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.PaTup (loc, (p :: pl)) : 'pattern));
       [Gramext.Stoken ("", "("); Gramext.Sself; Gramext.Stoken ("", ")")],
       Gramext.action
-        (fun _ (p : 'pattern) _ (loc : int * int) -> (p : 'pattern));
+        (fun _ (p : 'pattern) _ (loc : Lexing.position * Lexing.position) ->
+           (p : 'pattern));
       [Gramext.Stoken ("", "_")],
       Gramext.action
-        (fun _ (loc : int * int) -> (MLast.PaAny loc : 'pattern));
+        (fun _ (loc : Lexing.position * Lexing.position) ->
+           (MLast.PaAny loc : 'pattern));
       [Gramext.Stoken ("LIDENT", "")],
       Gramext.action
-        (fun (i : string) (loc : int * int) ->
+        (fun (i : string) (loc : Lexing.position * Lexing.position) ->
            (MLast.PaLid (loc, i) : 'pattern))]];
     Grammar.Entry.obj (patterns_comma : 'patterns_comma Grammar.Entry.e),
     None,
@@ -1977,49 +2059,54 @@ Grammar.extend
        Gramext.Snterm
          (Grammar.Entry.obj (pattern : 'pattern Grammar.Entry.e))],
       Gramext.action
-        (fun (p : 'pattern) _ (pl : 'patterns_comma) (loc : int * int) ->
+        (fun (p : 'pattern) _ (pl : 'patterns_comma)
+           (loc : Lexing.position * Lexing.position) ->
            (pl @ [p] : 'patterns_comma))];
      None, None,
      [[Gramext.Snterm
          (Grammar.Entry.obj (pattern : 'pattern Grammar.Entry.e))],
       Gramext.action
-        (fun (p : 'pattern) (loc : int * int) -> ([p] : 'patterns_comma))]];
+        (fun (p : 'pattern) (loc : Lexing.position * Lexing.position) ->
+           ([p] : 'patterns_comma))]];
     Grammar.Entry.obj (name : 'name Grammar.Entry.e), None,
     [None, None,
      [[Gramext.Snterm (Grammar.Entry.obj (qualid : 'qualid Grammar.Entry.e))],
       Gramext.action
-        (fun (e : 'qualid) (loc : int * int) -> (mk_name loc e : 'name))]];
+        (fun (e : 'qualid) (loc : Lexing.position * Lexing.position) ->
+           (mk_name loc e : 'name))]];
     Grammar.Entry.obj (qualid : 'qualid Grammar.Entry.e), None,
     [None, None,
      [[Gramext.Sself; Gramext.Stoken ("", "."); Gramext.Sself],
       Gramext.action
-        (fun (e2 : 'qualid) _ (e1 : 'qualid) (loc : int * int) ->
+        (fun (e2 : 'qualid) _ (e1 : 'qualid)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExAcc (loc, e1, e2) : 'qualid))];
      None, None,
      [[Gramext.Stoken ("LIDENT", "")],
       Gramext.action
-        (fun (i : string) (loc : int * int) ->
+        (fun (i : string) (loc : Lexing.position * Lexing.position) ->
            (MLast.ExLid (loc, i) : 'qualid));
       [Gramext.Stoken ("UIDENT", "")],
       Gramext.action
-        (fun (i : string) (loc : int * int) ->
+        (fun (i : string) (loc : Lexing.position * Lexing.position) ->
            (MLast.ExUid (loc, i) : 'qualid))]];
     Grammar.Entry.obj (string : 'string Grammar.Entry.e), None,
     [None, None,
      [[Gramext.Stoken ("ANTIQUOT", "")],
       Gramext.action
-        (fun (i : string) (loc : int * int) ->
-           (let shift = fst loc + String.length "$" in
+        (fun (i : string) (loc : Lexing.position * Lexing.position) ->
+           (let shift = Reloc.shift_pos (String.length "$") (fst loc) in
             let e =
               try Grammar.Entry.parse Pcaml.expr_eoi (Stream.of_string i) with
                 Exc_located ((bp, ep), exc) ->
-                  raise_with_loc (shift + bp, shift + ep) exc
+                  raise_with_loc (Reloc.adjust_loc shift (bp, ep)) exc
             in
-            Pcaml.expr_reloc (fun (bp, ep) -> shift + bp, shift + ep) 0 e :
+            Pcaml.expr_reloc (fun (bp, ep) -> Reloc.adjust_loc shift (bp, ep))
+              zero_loc e :
             'string));
       [Gramext.Stoken ("STRING", "")],
       Gramext.action
-        (fun (s : string) (loc : int * int) ->
+        (fun (s : string) (loc : Lexing.position * Lexing.position) ->
            (MLast.ExStr (loc, s) : 'string))]]]);;
 
 Pcaml.add_option "-quotify" (Arg.Set quotify) "Generate code for quotations";;
diff --git a/camlp4/ocaml_src/meta/pa_extend_m.ml b/camlp4/ocaml_src/meta/pa_extend_m.ml
index 11fd07f58a..c6da0eb8af 100644
--- a/camlp4/ocaml_src/meta/pa_extend_m.ml
+++ b/camlp4/ocaml_src/meta/pa_extend_m.ml
@@ -20,12 +20,17 @@ Grammar.extend
    [None, Some Gramext.NonA,
     [[Gramext.Stoken ("UIDENT", "SOPT"); Gramext.Sself],
      Gramext.action
-       (fun (s : 'symbol) _ (loc : int * int) -> (ssopt loc s : 'symbol));
+       (fun (s : 'symbol) _ (loc : Lexing.position * Lexing.position) ->
+          (ssopt loc s : 'symbol));
      [Gramext.srules
         [[Gramext.Stoken ("UIDENT", "SLIST1")],
-         Gramext.action (fun _ (loc : int * int) -> (true : 'e__1));
+         Gramext.action
+           (fun _ (loc : Lexing.position * Lexing.position) ->
+              (true : 'e__1));
          [Gramext.Stoken ("UIDENT", "SLIST0")],
-         Gramext.action (fun _ (loc : int * int) -> (false : 'e__1))];
+         Gramext.action
+           (fun _ (loc : Lexing.position * Lexing.position) ->
+              (false : 'e__1))];
       Gramext.Sself;
       Gramext.Sopt
         (Gramext.srules
@@ -33,8 +38,10 @@ Grammar.extend
              Gramext.Snterm
                (Grammar.Entry.obj (symbol : 'symbol Grammar.Entry.e))],
             Gramext.action
-              (fun (t : 'symbol) _ (loc : int * int) -> (t : 'e__2))])],
+              (fun (t : 'symbol) _
+                 (loc : Lexing.position * Lexing.position) ->
+                 (t : 'e__2))])],
      Gramext.action
        (fun (sep : 'e__2 option) (s : 'symbol) (min : 'e__1)
-          (loc : int * int) ->
+          (loc : Lexing.position * Lexing.position) ->
           (sslist loc min sep s : 'symbol))]]];;
diff --git a/camlp4/ocaml_src/meta/pa_ifdef.ml b/camlp4/ocaml_src/meta/pa_ifdef.ml
index 6384d6be1f..f55c647814 100644
--- a/camlp4/ocaml_src/meta/pa_ifdef.ml
+++ b/camlp4/ocaml_src/meta/pa_ifdef.ml
@@ -40,14 +40,14 @@ Grammar.extend
        Gramext.Stoken ("", "else"); Gramext.Sself],
       Gramext.action
         (fun (e2 : 'Pcaml__expr) _ (e1 : 'Pcaml__expr) _ (c : string) _
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (if List.mem c !defined then e2 else e1 : 'Pcaml__expr));
       [Gramext.Stoken ("", "ifdef"); Gramext.Stoken ("UIDENT", "");
        Gramext.Stoken ("", "then"); Gramext.Sself;
        Gramext.Stoken ("", "else"); Gramext.Sself],
       Gramext.action
         (fun (e2 : 'Pcaml__expr) _ (e1 : 'Pcaml__expr) _ (c : string) _
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (if List.mem c !defined then e1 else e2 : 'Pcaml__expr))]];
     Grammar.Entry.obj (Pcaml.str_item : 'Pcaml__str_item Grammar.Entry.e),
     Some Gramext.First,
@@ -56,7 +56,7 @@ Grammar.extend
          (Grammar.Entry.obj
             (def_undef_str : 'def_undef_str Grammar.Entry.e))],
       Gramext.action
-        (fun (x : 'def_undef_str) (loc : int * int) ->
+        (fun (x : 'def_undef_str) (loc : Lexing.position * Lexing.position) ->
            (match x with
               SdStr si -> si
             | SdDef x -> define x; MLast.StDcl (loc, [])
@@ -67,17 +67,20 @@ Grammar.extend
     [None, None,
      [[Gramext.Stoken ("", "undef"); Gramext.Stoken ("UIDENT", "")],
       Gramext.action
-        (fun (c : string) _ (loc : int * int) -> (SdUnd c : 'def_undef_str));
+        (fun (c : string) _ (loc : Lexing.position * Lexing.position) ->
+           (SdUnd c : 'def_undef_str));
       [Gramext.Stoken ("", "define"); Gramext.Stoken ("UIDENT", "")],
       Gramext.action
-        (fun (c : string) _ (loc : int * int) -> (SdDef c : 'def_undef_str));
+        (fun (c : string) _ (loc : Lexing.position * Lexing.position) ->
+           (SdDef c : 'def_undef_str));
       [Gramext.Stoken ("", "ifndef"); Gramext.Stoken ("UIDENT", "");
        Gramext.Stoken ("", "then");
        Gramext.Snterm
          (Grammar.Entry.obj
             (str_item_def_undef : 'str_item_def_undef Grammar.Entry.e))],
       Gramext.action
-        (fun (e1 : 'str_item_def_undef) _ (c : string) _ (loc : int * int) ->
+        (fun (e1 : 'str_item_def_undef) _ (c : string) _
+           (loc : Lexing.position * Lexing.position) ->
            (if List.mem c !defined then SdNop else e1 : 'def_undef_str));
       [Gramext.Stoken ("", "ifndef"); Gramext.Stoken ("UIDENT", "");
        Gramext.Stoken ("", "then");
@@ -90,7 +93,7 @@ Grammar.extend
             (str_item_def_undef : 'str_item_def_undef Grammar.Entry.e))],
       Gramext.action
         (fun (e2 : 'str_item_def_undef) _ (e1 : 'str_item_def_undef) _
-           (c : string) _ (loc : int * int) ->
+           (c : string) _ (loc : Lexing.position * Lexing.position) ->
            (if List.mem c !defined then e2 else e1 : 'def_undef_str));
       [Gramext.Stoken ("", "ifdef"); Gramext.Stoken ("UIDENT", "");
        Gramext.Stoken ("", "then");
@@ -98,7 +101,8 @@ Grammar.extend
          (Grammar.Entry.obj
             (str_item_def_undef : 'str_item_def_undef Grammar.Entry.e))],
       Gramext.action
-        (fun (e1 : 'str_item_def_undef) _ (c : string) _ (loc : int * int) ->
+        (fun (e1 : 'str_item_def_undef) _ (c : string) _
+           (loc : Lexing.position * Lexing.position) ->
            (if List.mem c !defined then e1 else SdNop : 'def_undef_str));
       [Gramext.Stoken ("", "ifdef"); Gramext.Stoken ("UIDENT", "");
        Gramext.Stoken ("", "then");
@@ -111,7 +115,7 @@ Grammar.extend
             (str_item_def_undef : 'str_item_def_undef Grammar.Entry.e))],
       Gramext.action
         (fun (e2 : 'str_item_def_undef) _ (e1 : 'str_item_def_undef) _
-           (c : string) _ (loc : int * int) ->
+           (c : string) _ (loc : Lexing.position * Lexing.position) ->
            (if List.mem c !defined then e1 else e2 : 'def_undef_str))]];
     Grammar.Entry.obj
       (str_item_def_undef : 'str_item_def_undef Grammar.Entry.e),
@@ -121,13 +125,14 @@ Grammar.extend
          (Grammar.Entry.obj
             (Pcaml.str_item : 'Pcaml__str_item Grammar.Entry.e))],
       Gramext.action
-        (fun (si : 'Pcaml__str_item) (loc : int * int) ->
+        (fun (si : 'Pcaml__str_item)
+           (loc : Lexing.position * Lexing.position) ->
            (SdStr si : 'str_item_def_undef));
       [Gramext.Snterm
          (Grammar.Entry.obj
             (def_undef_str : 'def_undef_str Grammar.Entry.e))],
       Gramext.action
-        (fun (d : 'def_undef_str) (loc : int * int) ->
+        (fun (d : 'def_undef_str) (loc : Lexing.position * Lexing.position) ->
            (d : 'str_item_def_undef))]];
     Grammar.Entry.obj (Pcaml.sig_item : 'Pcaml__sig_item Grammar.Entry.e),
     Some Gramext.First,
@@ -136,7 +141,7 @@ Grammar.extend
          (Grammar.Entry.obj
             (def_undef_sig : 'def_undef_sig Grammar.Entry.e))],
       Gramext.action
-        (fun (x : 'def_undef_sig) (loc : int * int) ->
+        (fun (x : 'def_undef_sig) (loc : Lexing.position * Lexing.position) ->
            (match x with
               SdStr si -> si
             | SdDef x -> define x; MLast.SgDcl (loc, [])
@@ -147,17 +152,20 @@ Grammar.extend
     [None, None,
      [[Gramext.Stoken ("", "undef"); Gramext.Stoken ("UIDENT", "")],
       Gramext.action
-        (fun (c : string) _ (loc : int * int) -> (SdUnd c : 'def_undef_sig));
+        (fun (c : string) _ (loc : Lexing.position * Lexing.position) ->
+           (SdUnd c : 'def_undef_sig));
       [Gramext.Stoken ("", "define"); Gramext.Stoken ("UIDENT", "")],
       Gramext.action
-        (fun (c : string) _ (loc : int * int) -> (SdDef c : 'def_undef_sig));
+        (fun (c : string) _ (loc : Lexing.position * Lexing.position) ->
+           (SdDef c : 'def_undef_sig));
       [Gramext.Stoken ("", "ifndef"); Gramext.Stoken ("UIDENT", "");
        Gramext.Stoken ("", "then");
        Gramext.Snterm
          (Grammar.Entry.obj
             (sig_item_def_undef : 'sig_item_def_undef Grammar.Entry.e))],
       Gramext.action
-        (fun (e1 : 'sig_item_def_undef) _ (c : string) _ (loc : int * int) ->
+        (fun (e1 : 'sig_item_def_undef) _ (c : string) _
+           (loc : Lexing.position * Lexing.position) ->
            (if List.mem c !defined then SdNop else e1 : 'def_undef_sig));
       [Gramext.Stoken ("", "ifndef"); Gramext.Stoken ("UIDENT", "");
        Gramext.Stoken ("", "then");
@@ -170,7 +178,7 @@ Grammar.extend
             (sig_item_def_undef : 'sig_item_def_undef Grammar.Entry.e))],
       Gramext.action
         (fun (e2 : 'sig_item_def_undef) _ (e1 : 'sig_item_def_undef) _
-           (c : string) _ (loc : int * int) ->
+           (c : string) _ (loc : Lexing.position * Lexing.position) ->
            (if List.mem c !defined then e2 else e1 : 'def_undef_sig));
       [Gramext.Stoken ("", "ifdef"); Gramext.Stoken ("UIDENT", "");
        Gramext.Stoken ("", "then");
@@ -178,7 +186,8 @@ Grammar.extend
          (Grammar.Entry.obj
             (sig_item_def_undef : 'sig_item_def_undef Grammar.Entry.e))],
       Gramext.action
-        (fun (e1 : 'sig_item_def_undef) _ (c : string) _ (loc : int * int) ->
+        (fun (e1 : 'sig_item_def_undef) _ (c : string) _
+           (loc : Lexing.position * Lexing.position) ->
            (if List.mem c !defined then e1 else SdNop : 'def_undef_sig));
       [Gramext.Stoken ("", "ifdef"); Gramext.Stoken ("UIDENT", "");
        Gramext.Stoken ("", "then");
@@ -191,7 +200,7 @@ Grammar.extend
             (sig_item_def_undef : 'sig_item_def_undef Grammar.Entry.e))],
       Gramext.action
         (fun (e2 : 'sig_item_def_undef) _ (e1 : 'sig_item_def_undef) _
-           (c : string) _ (loc : int * int) ->
+           (c : string) _ (loc : Lexing.position * Lexing.position) ->
            (if List.mem c !defined then e1 else e2 : 'def_undef_sig))]];
     Grammar.Entry.obj
       (sig_item_def_undef : 'sig_item_def_undef Grammar.Entry.e),
@@ -201,13 +210,14 @@ Grammar.extend
          (Grammar.Entry.obj
             (Pcaml.sig_item : 'Pcaml__sig_item Grammar.Entry.e))],
       Gramext.action
-        (fun (si : 'Pcaml__sig_item) (loc : int * int) ->
+        (fun (si : 'Pcaml__sig_item)
+           (loc : Lexing.position * Lexing.position) ->
            (SdStr si : 'sig_item_def_undef));
       [Gramext.Snterm
          (Grammar.Entry.obj
             (def_undef_sig : 'def_undef_sig Grammar.Entry.e))],
       Gramext.action
-        (fun (d : 'def_undef_sig) (loc : int * int) ->
+        (fun (d : 'def_undef_sig) (loc : Lexing.position * Lexing.position) ->
            (d : 'sig_item_def_undef))]]]);;
 
 Pcaml.add_option "-D" (Arg.String define)
diff --git a/camlp4/ocaml_src/meta/pa_macro.ml b/camlp4/ocaml_src/meta/pa_macro.ml
index 599608f9fa..b70f5c6171 100644
--- a/camlp4/ocaml_src/meta/pa_macro.ml
+++ b/camlp4/ocaml_src/meta/pa_macro.ml
@@ -64,7 +64,12 @@ let defined = ref [];;
 
 let is_defined i = List.mem_assoc i !defined;;
 
-let loc = 0, 0;;
+let loc =
+  let nowhere =
+    {(Lexing.dummy_pos) with Lexing.pos_lnum = 1; Lexing.pos_cnum = 0}
+  in
+  nowhere, nowhere
+;;
 
 let subst mloc env =
   let rec loop =
@@ -129,16 +134,16 @@ let define eo x =
          [None, None,
           [[Gramext.Stoken ("UIDENT", x)],
            Gramext.action
-             (fun _ (loc : int * int) ->
-                (Pcaml.expr_reloc (fun _ -> loc) 0 e : 'expr))]];
+             (fun _ (loc : Lexing.position * Lexing.position) ->
+                (Pcaml.expr_reloc (fun _ -> loc) (fst loc) e : 'expr))]];
          Grammar.Entry.obj (patt : 'patt Grammar.Entry.e),
          Some (Gramext.Level "simple"),
          [None, None,
           [[Gramext.Stoken ("UIDENT", x)],
            Gramext.action
-             (fun _ (loc : int * int) ->
+             (fun _ (loc : Lexing.position * Lexing.position) ->
                 (let p = substp loc [] e in
-                 Pcaml.patt_reloc (fun _ -> loc) 0 p :
+                 Pcaml.patt_reloc (fun _ -> loc) (fst loc) p :
                  'patt))]]]
   | Some (sl, e) ->
       Grammar.extend
@@ -147,7 +152,8 @@ let define eo x =
          [None, None,
           [[Gramext.Stoken ("UIDENT", x); Gramext.Sself],
            Gramext.action
-             (fun (param : 'expr) _ (loc : int * int) ->
+             (fun (param : 'expr) _
+                (loc : Lexing.position * Lexing.position) ->
                 (let el =
                    match param with
                      MLast.ExTup (_, el) -> el
@@ -156,7 +162,7 @@ let define eo x =
                  if List.length el = List.length sl then
                    let env = List.combine sl el in
                    let e = subst loc env e in
-                   Pcaml.expr_reloc (fun _ -> loc) 0 e
+                   Pcaml.expr_reloc (fun _ -> loc) (fst loc) e
                  else incorrect_number loc el sl :
                  'expr))]];
          Grammar.Entry.obj (patt : 'patt Grammar.Entry.e),
@@ -164,7 +170,8 @@ let define eo x =
          [None, None,
           [[Gramext.Stoken ("UIDENT", x); Gramext.Sself],
            Gramext.action
-             (fun (param : 'patt) _ (loc : int * int) ->
+             (fun (param : 'patt) _
+                (loc : Lexing.position * Lexing.position) ->
                 (let pl =
                    match param with
                      MLast.PaTup (_, pl) -> pl
@@ -173,7 +180,7 @@ let define eo x =
                  if List.length pl = List.length sl then
                    let env = List.combine sl pl in
                    let p = substp loc env e in
-                   Pcaml.patt_reloc (fun _ -> loc) 0 p
+                   Pcaml.patt_reloc (fun _ -> loc) (fst loc) p
                  else incorrect_number loc pl sl :
                  'patt))]]]
   | None -> ()
@@ -220,7 +227,7 @@ Grammar.extend
      [[Gramext.Snterm
          (Grammar.Entry.obj (macro_def : 'macro_def Grammar.Entry.e))],
       Gramext.action
-        (fun (x : 'macro_def) (loc : int * int) ->
+        (fun (x : 'macro_def) (loc : Lexing.position * Lexing.position) ->
            (match x with
               SdStr [si] -> si
             | SdStr sil -> MLast.StDcl (loc, sil)
@@ -243,7 +250,7 @@ Grammar.extend
        Gramext.Stoken ("", "END")],
       Gramext.action
         (fun _ (d2 : 'str_item_or_macro) _ (d1 : 'str_item_or_macro) _
-           (i : 'uident) _ (loc : int * int) ->
+           (i : 'uident) _ (loc : Lexing.position * Lexing.position) ->
            (if is_defined i then d2 else d1 : 'macro_def));
       [Gramext.Stoken ("", "IFNDEF");
        Gramext.Snterm (Grammar.Entry.obj (uident : 'uident Grammar.Entry.e));
@@ -253,7 +260,8 @@ Grammar.extend
             (str_item_or_macro : 'str_item_or_macro Grammar.Entry.e));
        Gramext.Stoken ("", "END")],
       Gramext.action
-        (fun _ (d : 'str_item_or_macro) _ (i : 'uident) _ (loc : int * int) ->
+        (fun _ (d : 'str_item_or_macro) _ (i : 'uident) _
+           (loc : Lexing.position * Lexing.position) ->
            (if is_defined i then SdNop else d : 'macro_def));
       [Gramext.Stoken ("", "IFDEF");
        Gramext.Snterm (Grammar.Entry.obj (uident : 'uident Grammar.Entry.e));
@@ -268,7 +276,7 @@ Grammar.extend
        Gramext.Stoken ("", "END")],
       Gramext.action
         (fun _ (d2 : 'str_item_or_macro) _ (d1 : 'str_item_or_macro) _
-           (i : 'uident) _ (loc : int * int) ->
+           (i : 'uident) _ (loc : Lexing.position * Lexing.position) ->
            (if is_defined i then d1 else d2 : 'macro_def));
       [Gramext.Stoken ("", "IFDEF");
        Gramext.Snterm (Grammar.Entry.obj (uident : 'uident Grammar.Entry.e));
@@ -278,19 +286,22 @@ Grammar.extend
             (str_item_or_macro : 'str_item_or_macro Grammar.Entry.e));
        Gramext.Stoken ("", "END")],
       Gramext.action
-        (fun _ (d : 'str_item_or_macro) _ (i : 'uident) _ (loc : int * int) ->
+        (fun _ (d : 'str_item_or_macro) _ (i : 'uident) _
+           (loc : Lexing.position * Lexing.position) ->
            (if is_defined i then d else SdNop : 'macro_def));
       [Gramext.Stoken ("", "UNDEF");
        Gramext.Snterm (Grammar.Entry.obj (uident : 'uident Grammar.Entry.e))],
       Gramext.action
-        (fun (i : 'uident) _ (loc : int * int) -> (SdUnd i : 'macro_def));
+        (fun (i : 'uident) _ (loc : Lexing.position * Lexing.position) ->
+           (SdUnd i : 'macro_def));
       [Gramext.Stoken ("", "DEFINE");
        Gramext.Snterm (Grammar.Entry.obj (uident : 'uident Grammar.Entry.e));
        Gramext.Snterm
          (Grammar.Entry.obj
             (opt_macro_value : 'opt_macro_value Grammar.Entry.e))],
       Gramext.action
-        (fun (def : 'opt_macro_value) (i : 'uident) _ (loc : int * int) ->
+        (fun (def : 'opt_macro_value) (i : 'uident) _
+           (loc : Lexing.position * Lexing.position) ->
            (SdDef (i, def) : 'macro_def))]];
     Grammar.Entry.obj
       (str_item_or_macro : 'str_item_or_macro Grammar.Entry.e),
@@ -300,21 +311,25 @@ Grammar.extend
          (Gramext.Snterm
             (Grammar.Entry.obj (str_item : 'str_item Grammar.Entry.e)))],
       Gramext.action
-        (fun (si : 'str_item list) (loc : int * int) ->
+        (fun (si : 'str_item list)
+           (loc : Lexing.position * Lexing.position) ->
            (SdStr si : 'str_item_or_macro));
       [Gramext.Snterm
          (Grammar.Entry.obj (macro_def : 'macro_def Grammar.Entry.e))],
       Gramext.action
-        (fun (d : 'macro_def) (loc : int * int) ->
+        (fun (d : 'macro_def) (loc : Lexing.position * Lexing.position) ->
            (d : 'str_item_or_macro))]];
     Grammar.Entry.obj (opt_macro_value : 'opt_macro_value Grammar.Entry.e),
     None,
     [None, None,
-     [[], Gramext.action (fun (loc : int * int) -> (None : 'opt_macro_value));
+     [[],
+      Gramext.action
+        (fun (loc : Lexing.position * Lexing.position) ->
+           (None : 'opt_macro_value));
       [Gramext.Stoken ("", "=");
        Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))],
       Gramext.action
-        (fun (e : 'expr) _ (loc : int * int) ->
+        (fun (e : 'expr) _ (loc : Lexing.position * Lexing.position) ->
            (Some ([], e) : 'opt_macro_value));
       [Gramext.Stoken ("", "(");
        Gramext.Slist1sep
@@ -322,7 +337,8 @@ Grammar.extend
        Gramext.Stoken ("", ")"); Gramext.Stoken ("", "=");
        Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))],
       Gramext.action
-        (fun (e : 'expr) _ _ (pl : string list) _ (loc : int * int) ->
+        (fun (e : 'expr) _ _ (pl : string list) _
+           (loc : Lexing.position * Lexing.position) ->
            (Some (pl, e) : 'opt_macro_value))]];
     Grammar.Entry.obj (expr : 'expr Grammar.Entry.e),
     Some (Gramext.Level "top"),
@@ -334,7 +350,7 @@ Grammar.extend
        Gramext.Stoken ("", "END")],
       Gramext.action
         (fun _ (e2 : 'expr) _ (e1 : 'expr) _ (i : 'uident) _
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (if is_defined i then e2 else e1 : 'expr));
       [Gramext.Stoken ("", "IFDEF");
        Gramext.Snterm (Grammar.Entry.obj (uident : 'uident Grammar.Entry.e));
@@ -343,22 +359,22 @@ Grammar.extend
        Gramext.Stoken ("", "END")],
       Gramext.action
         (fun _ (e2 : 'expr) _ (e1 : 'expr) _ (i : 'uident) _
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (if is_defined i then e1 else e2 : 'expr))]];
     Grammar.Entry.obj (expr : 'expr Grammar.Entry.e),
     Some (Gramext.Level "simple"),
     [None, None,
      [[Gramext.Stoken ("LIDENT", "__LOCATION__")],
       Gramext.action
-        (fun _ (loc : int * int) ->
-           (let bp = string_of_int (fst loc) in
-            let ep = string_of_int (snd loc) in
+        (fun _ (loc : Lexing.position * Lexing.position) ->
+           (let bp = string_of_int (fst loc).Lexing.pos_cnum in
+            let ep = string_of_int (snd loc).Lexing.pos_cnum in
             MLast.ExTup
               (loc, [MLast.ExInt (loc, bp); MLast.ExInt (loc, ep)]) :
             'expr));
       [Gramext.Stoken ("LIDENT", "__FILE__")],
       Gramext.action
-        (fun _ (loc : int * int) ->
+        (fun _ (loc : Lexing.position * Lexing.position) ->
            (MLast.ExStr (loc, !(Pcaml.input_file)) : 'expr))]];
     Grammar.Entry.obj (patt : 'patt Grammar.Entry.e), None,
     [None, None,
@@ -369,7 +385,7 @@ Grammar.extend
        Gramext.Stoken ("", "END")],
       Gramext.action
         (fun _ (p2 : 'patt) _ (p1 : 'patt) _ (i : 'uident) _
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (if is_defined i then p2 else p1 : 'patt));
       [Gramext.Stoken ("", "IFDEF");
        Gramext.Snterm (Grammar.Entry.obj (uident : 'uident Grammar.Entry.e));
@@ -378,13 +394,14 @@ Grammar.extend
        Gramext.Stoken ("", "END")],
       Gramext.action
         (fun _ (p2 : 'patt) _ (p1 : 'patt) _ (i : 'uident) _
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (if is_defined i then p1 else p2 : 'patt))]];
     Grammar.Entry.obj (uident : 'uident Grammar.Entry.e), None,
     [None, None,
      [[Gramext.Stoken ("UIDENT", "")],
       Gramext.action
-        (fun (i : string) (loc : int * int) -> (i : 'uident))]]]);;
+        (fun (i : string) (loc : Lexing.position * Lexing.position) ->
+           (i : 'uident))]]]);;
 
 Pcaml.add_option "-D" (Arg.String (define None))
   "<string> Define for IFDEF instruction.";;
diff --git a/camlp4/ocaml_src/meta/pa_r.ml b/camlp4/ocaml_src/meta/pa_r.ml
index 013adfa8d6..b380dbcefc 100644
--- a/camlp4/ocaml_src/meta/pa_r.ml
+++ b/camlp4/ocaml_src/meta/pa_r.ml
@@ -19,16 +19,7 @@ Pcaml.no_constructors_arity := false;;
 
 let help_sequences () =
   Printf.eprintf "\
-New syntax:
-     do {e1; e2; ... ; en}
-     while e do {e1; e2; ... ; en}
-     for v = v1 to/downto v2 do {e1; e2; ... ; en}
-Old (discouraged) syntax:
-     do e1; e2; ... ; en-1; return en
-     while e do e1; e2; ... ; en; done
-     for v = v1 to/downto v2 do e1; e2; ... ; en; done
-To avoid compilation warning use the new syntax.
-";
+New syntax:     do {e1; e2; ... ; en}     while e do {e1; e2; ... ; en}     for v = v1 to/downto v2 do {e1; e2; ... ; en}Old (discouraged) syntax:     do e1; e2; ... ; en-1; return en     while e do e1; e2; ... ; en; done     for v = v1 to/downto v2 do e1; e2; ... ; en; doneTo avoid compilation warning use the new syntax.";
   flush stderr;
   exit 1
 ;;
@@ -282,6 +273,8 @@ Grammar.extend
      grammar_entry_create "class_type_declaration"
    and field_expr : 'field_expr Grammar.Entry.e =
      grammar_entry_create "field_expr"
+   and meth_list : 'meth_list Grammar.Entry.e =
+     grammar_entry_create "meth_list"
    and field : 'field Grammar.Entry.e = grammar_entry_create "field"
    and typevar : 'typevar Grammar.Entry.e = grammar_entry_create "typevar"
    and clty_longident : 'clty_longident Grammar.Entry.e =
@@ -312,10 +305,13 @@ Grammar.extend
                 (Grammar.Entry.obj (str_item : 'str_item Grammar.Entry.e));
               Gramext.Stoken ("", ";")],
              Gramext.action
-               (fun _ (s : 'str_item) (loc : int * int) -> (s : 'e__1))]);
+               (fun _ (s : 'str_item)
+                  (loc : Lexing.position * Lexing.position) ->
+                  (s : 'e__1))]);
        Gramext.Stoken ("", "end")],
       Gramext.action
-        (fun _ (st : 'e__1 list) _ (loc : int * int) ->
+        (fun _ (st : 'e__1 list) _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.MeStr (loc, st) : 'module_expr));
       [Gramext.Stoken ("", "functor"); Gramext.Stoken ("", "(");
        Gramext.Stoken ("UIDENT", ""); Gramext.Stoken ("", ":");
@@ -324,22 +320,25 @@ Grammar.extend
        Gramext.Stoken ("", ")"); Gramext.Stoken ("", "->"); Gramext.Sself],
       Gramext.action
         (fun (me : 'module_expr) _ _ (t : 'module_type) _ (i : string) _ _
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.MeFun (loc, i, t, me) : 'module_expr))];
      None, None,
      [[Gramext.Sself; Gramext.Sself],
       Gramext.action
-        (fun (me2 : 'module_expr) (me1 : 'module_expr) (loc : int * int) ->
+        (fun (me2 : 'module_expr) (me1 : 'module_expr)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.MeApp (loc, me1, me2) : 'module_expr))];
      None, None,
      [[Gramext.Sself; Gramext.Stoken ("", "."); Gramext.Sself],
       Gramext.action
-        (fun (me2 : 'module_expr) _ (me1 : 'module_expr) (loc : int * int) ->
+        (fun (me2 : 'module_expr) _ (me1 : 'module_expr)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.MeAcc (loc, me1, me2) : 'module_expr))];
      Some "simple", None,
      [[Gramext.Stoken ("", "("); Gramext.Sself; Gramext.Stoken ("", ")")],
       Gramext.action
-        (fun _ (me : 'module_expr) _ (loc : int * int) ->
+        (fun _ (me : 'module_expr) _
+           (loc : Lexing.position * Lexing.position) ->
            (me : 'module_expr));
       [Gramext.Stoken ("", "("); Gramext.Sself; Gramext.Stoken ("", ":");
        Gramext.Snterm
@@ -347,17 +346,17 @@ Grammar.extend
        Gramext.Stoken ("", ")")],
       Gramext.action
         (fun _ (mt : 'module_type) _ (me : 'module_expr) _
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.MeTyc (loc, me, mt) : 'module_expr));
       [Gramext.Stoken ("UIDENT", "")],
       Gramext.action
-        (fun (i : string) (loc : int * int) ->
+        (fun (i : string) (loc : Lexing.position * Lexing.position) ->
            (MLast.MeUid (loc, i) : 'module_expr))]];
     Grammar.Entry.obj (str_item : 'str_item Grammar.Entry.e), None,
     [Some "top", None,
      [[Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))],
       Gramext.action
-        (fun (e : 'expr) (loc : int * int) ->
+        (fun (e : 'expr) (loc : Lexing.position * Lexing.position) ->
            (MLast.StExp (loc, e) : 'str_item));
       [Gramext.Stoken ("", "value");
        Gramext.Sopt (Gramext.Stoken ("", "rec"));
@@ -367,7 +366,7 @@ Grammar.extend
           Gramext.Stoken ("", "and"))],
       Gramext.action
         (fun (l : 'let_binding list) (r : string option) _
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.StVal (loc, o2b r, l) : 'str_item));
       [Gramext.Stoken ("", "type");
        Gramext.Slist1sep
@@ -376,20 +375,22 @@ Grammar.extend
                (type_declaration : 'type_declaration Grammar.Entry.e)),
           Gramext.Stoken ("", "and"))],
       Gramext.action
-        (fun (tdl : 'type_declaration list) _ (loc : int * int) ->
+        (fun (tdl : 'type_declaration list) _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.StTyp (loc, tdl) : 'str_item));
       [Gramext.Stoken ("", "open");
        Gramext.Snterm
          (Grammar.Entry.obj (mod_ident : 'mod_ident Grammar.Entry.e))],
       Gramext.action
-        (fun (i : 'mod_ident) _ (loc : int * int) ->
+        (fun (i : 'mod_ident) _ (loc : Lexing.position * Lexing.position) ->
            (MLast.StOpn (loc, i) : 'str_item));
       [Gramext.Stoken ("", "module"); Gramext.Stoken ("", "type");
        Gramext.Stoken ("UIDENT", ""); Gramext.Stoken ("", "=");
        Gramext.Snterm
          (Grammar.Entry.obj (module_type : 'module_type Grammar.Entry.e))],
       Gramext.action
-        (fun (mt : 'module_type) _ (i : string) _ _ (loc : int * int) ->
+        (fun (mt : 'module_type) _ (i : string) _ _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.StMty (loc, i, mt) : 'str_item));
       [Gramext.Stoken ("", "module"); Gramext.Stoken ("", "rec");
        Gramext.Slist1sep
@@ -398,20 +399,23 @@ Grammar.extend
                (module_rec_binding : 'module_rec_binding Grammar.Entry.e)),
           Gramext.Stoken ("", "and"))],
       Gramext.action
-        (fun (nmtmes : 'module_rec_binding list) _ _ (loc : int * int) ->
+        (fun (nmtmes : 'module_rec_binding list) _ _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.StRecMod (loc, nmtmes) : 'str_item));
       [Gramext.Stoken ("", "module"); Gramext.Stoken ("UIDENT", "");
        Gramext.Snterm
          (Grammar.Entry.obj
             (module_binding : 'module_binding Grammar.Entry.e))],
       Gramext.action
-        (fun (mb : 'module_binding) (i : string) _ (loc : int * int) ->
+        (fun (mb : 'module_binding) (i : string) _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.StMod (loc, i, mb) : 'str_item));
       [Gramext.Stoken ("", "include");
        Gramext.Snterm
          (Grammar.Entry.obj (module_expr : 'module_expr Grammar.Entry.e))],
       Gramext.action
-        (fun (me : 'module_expr) _ (loc : int * int) ->
+        (fun (me : 'module_expr) _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.StInc (loc, me) : 'str_item));
       [Gramext.Stoken ("", "external"); Gramext.Stoken ("LIDENT", "");
        Gramext.Stoken ("", ":");
@@ -420,7 +424,7 @@ Grammar.extend
        Gramext.Slist1 (Gramext.Stoken ("STRING", ""))],
       Gramext.action
         (fun (pd : string list) _ (t : 'ctyp) _ (i : string) _
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.StExt (loc, i, t, pd) : 'str_item));
       [Gramext.Stoken ("", "exception");
        Gramext.Snterm
@@ -431,7 +435,7 @@ Grammar.extend
          (Grammar.Entry.obj (rebind_exn : 'rebind_exn Grammar.Entry.e))],
       Gramext.action
         (fun (b : 'rebind_exn) (_, c, tl : 'constructor_declaration) _
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.StExc (loc, c, tl, b) : 'str_item));
       [Gramext.Stoken ("", "declare");
        Gramext.Slist0
@@ -440,19 +444,25 @@ Grammar.extend
                 (Grammar.Entry.obj (str_item : 'str_item Grammar.Entry.e));
               Gramext.Stoken ("", ";")],
              Gramext.action
-               (fun _ (s : 'str_item) (loc : int * int) -> (s : 'e__2))]);
+               (fun _ (s : 'str_item)
+                  (loc : Lexing.position * Lexing.position) ->
+                  (s : 'e__2))]);
        Gramext.Stoken ("", "end")],
       Gramext.action
-        (fun _ (st : 'e__2 list) _ (loc : int * int) ->
+        (fun _ (st : 'e__2 list) _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.StDcl (loc, st) : 'str_item))]];
     Grammar.Entry.obj (rebind_exn : 'rebind_exn Grammar.Entry.e), None,
     [None, None,
-     [[], Gramext.action (fun (loc : int * int) -> ([] : 'rebind_exn));
+     [[],
+      Gramext.action
+        (fun (loc : Lexing.position * Lexing.position) -> ([] : 'rebind_exn));
       [Gramext.Stoken ("", "=");
        Gramext.Snterm
          (Grammar.Entry.obj (mod_ident : 'mod_ident Grammar.Entry.e))],
       Gramext.action
-        (fun (sl : 'mod_ident) _ (loc : int * int) -> (sl : 'rebind_exn))]];
+        (fun (sl : 'mod_ident) _ (loc : Lexing.position * Lexing.position) ->
+           (sl : 'rebind_exn))]];
     Grammar.Entry.obj (module_binding : 'module_binding Grammar.Entry.e),
     None,
     [None, Some Gramext.RightA,
@@ -460,7 +470,8 @@ Grammar.extend
        Gramext.Snterm
          (Grammar.Entry.obj (module_expr : 'module_expr Grammar.Entry.e))],
       Gramext.action
-        (fun (me : 'module_expr) _ (loc : int * int) ->
+        (fun (me : 'module_expr) _
+           (loc : Lexing.position * Lexing.position) ->
            (me : 'module_binding));
       [Gramext.Stoken ("", ":");
        Gramext.Snterm
@@ -469,7 +480,8 @@ Grammar.extend
        Gramext.Snterm
          (Grammar.Entry.obj (module_expr : 'module_expr Grammar.Entry.e))],
       Gramext.action
-        (fun (me : 'module_expr) _ (mt : 'module_type) _ (loc : int * int) ->
+        (fun (me : 'module_expr) _ (mt : 'module_type) _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.MeTyc (loc, me, mt) : 'module_binding));
       [Gramext.Stoken ("", "("); Gramext.Stoken ("UIDENT", "");
        Gramext.Stoken ("", ":");
@@ -478,7 +490,7 @@ Grammar.extend
        Gramext.Stoken ("", ")"); Gramext.Sself],
       Gramext.action
         (fun (mb : 'module_binding) _ (mt : 'module_type) _ (m : string) _
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.MeFun (loc, m, mt, mb) : 'module_binding))]];
     Grammar.Entry.obj
       (module_rec_binding : 'module_rec_binding Grammar.Entry.e),
@@ -492,7 +504,7 @@ Grammar.extend
          (Grammar.Entry.obj (module_expr : 'module_expr Grammar.Entry.e))],
       Gramext.action
         (fun (me : 'module_expr) _ (mt : 'module_type) _ (m : string)
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (m, mt, me : 'module_rec_binding))]];
     Grammar.Entry.obj (module_type : 'module_type Grammar.Entry.e), None,
     [None, None,
@@ -501,7 +513,7 @@ Grammar.extend
        Gramext.Stoken ("", ")"); Gramext.Stoken ("", "->"); Gramext.Sself],
       Gramext.action
         (fun (mt : 'module_type) _ _ (t : 'module_type) _ (i : string) _ _
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.MtFun (loc, i, t, mt) : 'module_type))];
      None, None,
      [[Gramext.Sself; Gramext.Stoken ("", "with");
@@ -511,7 +523,7 @@ Grammar.extend
           Gramext.Stoken ("", "and"))],
       Gramext.action
         (fun (wcl : 'with_constr list) _ (mt : 'module_type)
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.MtWit (loc, mt, wcl) : 'module_type))];
      None, None,
      [[Gramext.Stoken ("", "sig");
@@ -521,38 +533,44 @@ Grammar.extend
                 (Grammar.Entry.obj (sig_item : 'sig_item Grammar.Entry.e));
               Gramext.Stoken ("", ";")],
              Gramext.action
-               (fun _ (s : 'sig_item) (loc : int * int) -> (s : 'e__3))]);
+               (fun _ (s : 'sig_item)
+                  (loc : Lexing.position * Lexing.position) ->
+                  (s : 'e__3))]);
        Gramext.Stoken ("", "end")],
       Gramext.action
-        (fun _ (sg : 'e__3 list) _ (loc : int * int) ->
+        (fun _ (sg : 'e__3 list) _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.MtSig (loc, sg) : 'module_type))];
      None, None,
      [[Gramext.Sself; Gramext.Sself],
       Gramext.action
-        (fun (m2 : 'module_type) (m1 : 'module_type) (loc : int * int) ->
+        (fun (m2 : 'module_type) (m1 : 'module_type)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.MtApp (loc, m1, m2) : 'module_type))];
      None, None,
      [[Gramext.Sself; Gramext.Stoken ("", "."); Gramext.Sself],
       Gramext.action
-        (fun (m2 : 'module_type) _ (m1 : 'module_type) (loc : int * int) ->
+        (fun (m2 : 'module_type) _ (m1 : 'module_type)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.MtAcc (loc, m1, m2) : 'module_type))];
      Some "simple", None,
      [[Gramext.Stoken ("", "("); Gramext.Sself; Gramext.Stoken ("", ")")],
       Gramext.action
-        (fun _ (mt : 'module_type) _ (loc : int * int) ->
+        (fun _ (mt : 'module_type) _
+           (loc : Lexing.position * Lexing.position) ->
            (mt : 'module_type));
       [Gramext.Stoken ("", "'");
        Gramext.Snterm (Grammar.Entry.obj (ident : 'ident Grammar.Entry.e))],
       Gramext.action
-        (fun (i : 'ident) _ (loc : int * int) ->
+        (fun (i : 'ident) _ (loc : Lexing.position * Lexing.position) ->
            (MLast.MtQuo (loc, i) : 'module_type));
       [Gramext.Stoken ("LIDENT", "")],
       Gramext.action
-        (fun (i : string) (loc : int * int) ->
+        (fun (i : string) (loc : Lexing.position * Lexing.position) ->
            (MLast.MtLid (loc, i) : 'module_type));
       [Gramext.Stoken ("UIDENT", "")],
       Gramext.action
-        (fun (i : string) (loc : int * int) ->
+        (fun (i : string) (loc : Lexing.position * Lexing.position) ->
            (MLast.MtUid (loc, i) : 'module_type))]];
     Grammar.Entry.obj (sig_item : 'sig_item Grammar.Entry.e), None,
     [Some "top", None,
@@ -560,7 +578,8 @@ Grammar.extend
        Gramext.Stoken ("", ":");
        Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))],
       Gramext.action
-        (fun (t : 'ctyp) _ (i : string) _ (loc : int * int) ->
+        (fun (t : 'ctyp) _ (i : string) _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.SgVal (loc, i, t) : 'sig_item));
       [Gramext.Stoken ("", "type");
        Gramext.Slist1sep
@@ -569,20 +588,22 @@ Grammar.extend
                (type_declaration : 'type_declaration Grammar.Entry.e)),
           Gramext.Stoken ("", "and"))],
       Gramext.action
-        (fun (tdl : 'type_declaration list) _ (loc : int * int) ->
+        (fun (tdl : 'type_declaration list) _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.SgTyp (loc, tdl) : 'sig_item));
       [Gramext.Stoken ("", "open");
        Gramext.Snterm
          (Grammar.Entry.obj (mod_ident : 'mod_ident Grammar.Entry.e))],
       Gramext.action
-        (fun (i : 'mod_ident) _ (loc : int * int) ->
+        (fun (i : 'mod_ident) _ (loc : Lexing.position * Lexing.position) ->
            (MLast.SgOpn (loc, i) : 'sig_item));
       [Gramext.Stoken ("", "module"); Gramext.Stoken ("", "type");
        Gramext.Stoken ("UIDENT", ""); Gramext.Stoken ("", "=");
        Gramext.Snterm
          (Grammar.Entry.obj (module_type : 'module_type Grammar.Entry.e))],
       Gramext.action
-        (fun (mt : 'module_type) _ (i : string) _ _ (loc : int * int) ->
+        (fun (mt : 'module_type) _ (i : string) _ _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.SgMty (loc, i, mt) : 'sig_item));
       [Gramext.Stoken ("", "module"); Gramext.Stoken ("", "rec");
        Gramext.Slist1sep
@@ -592,20 +613,23 @@ Grammar.extend
                 'module_rec_declaration Grammar.Entry.e)),
           Gramext.Stoken ("", "and"))],
       Gramext.action
-        (fun (mds : 'module_rec_declaration list) _ _ (loc : int * int) ->
+        (fun (mds : 'module_rec_declaration list) _ _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.SgRecMod (loc, mds) : 'sig_item));
       [Gramext.Stoken ("", "module"); Gramext.Stoken ("UIDENT", "");
        Gramext.Snterm
          (Grammar.Entry.obj
             (module_declaration : 'module_declaration Grammar.Entry.e))],
       Gramext.action
-        (fun (mt : 'module_declaration) (i : string) _ (loc : int * int) ->
+        (fun (mt : 'module_declaration) (i : string) _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.SgMod (loc, i, mt) : 'sig_item));
       [Gramext.Stoken ("", "include");
        Gramext.Snterm
          (Grammar.Entry.obj (module_type : 'module_type Grammar.Entry.e))],
       Gramext.action
-        (fun (mt : 'module_type) _ (loc : int * int) ->
+        (fun (mt : 'module_type) _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.SgInc (loc, mt) : 'sig_item));
       [Gramext.Stoken ("", "external"); Gramext.Stoken ("LIDENT", "");
        Gramext.Stoken ("", ":");
@@ -614,7 +638,7 @@ Grammar.extend
        Gramext.Slist1 (Gramext.Stoken ("STRING", ""))],
       Gramext.action
         (fun (pd : string list) _ (t : 'ctyp) _ (i : string) _
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.SgExt (loc, i, t, pd) : 'sig_item));
       [Gramext.Stoken ("", "exception");
        Gramext.Snterm
@@ -622,7 +646,8 @@ Grammar.extend
             (constructor_declaration :
              'constructor_declaration Grammar.Entry.e))],
       Gramext.action
-        (fun (_, c, tl : 'constructor_declaration) _ (loc : int * int) ->
+        (fun (_, c, tl : 'constructor_declaration) _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.SgExc (loc, c, tl) : 'sig_item));
       [Gramext.Stoken ("", "declare");
        Gramext.Slist0
@@ -631,10 +656,13 @@ Grammar.extend
                 (Grammar.Entry.obj (sig_item : 'sig_item Grammar.Entry.e));
               Gramext.Stoken ("", ";")],
              Gramext.action
-               (fun _ (s : 'sig_item) (loc : int * int) -> (s : 'e__4))]);
+               (fun _ (s : 'sig_item)
+                  (loc : Lexing.position * Lexing.position) ->
+                  (s : 'e__4))]);
        Gramext.Stoken ("", "end")],
       Gramext.action
-        (fun _ (st : 'e__4 list) _ (loc : int * int) ->
+        (fun _ (st : 'e__4 list) _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.SgDcl (loc, st) : 'sig_item))]];
     Grammar.Entry.obj
       (module_declaration : 'module_declaration Grammar.Entry.e),
@@ -647,13 +675,14 @@ Grammar.extend
        Gramext.Stoken ("", ")"); Gramext.Sself],
       Gramext.action
         (fun (mt : 'module_declaration) _ (t : 'module_type) _ (i : string) _
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.MtFun (loc, i, t, mt) : 'module_declaration));
       [Gramext.Stoken ("", ":");
        Gramext.Snterm
          (Grammar.Entry.obj (module_type : 'module_type Grammar.Entry.e))],
       Gramext.action
-        (fun (mt : 'module_type) _ (loc : int * int) ->
+        (fun (mt : 'module_type) _
+           (loc : Lexing.position * Lexing.position) ->
            (mt : 'module_declaration))]];
     Grammar.Entry.obj
       (module_rec_declaration : 'module_rec_declaration Grammar.Entry.e),
@@ -663,7 +692,8 @@ Grammar.extend
        Gramext.Snterm
          (Grammar.Entry.obj (module_type : 'module_type Grammar.Entry.e))],
       Gramext.action
-        (fun (mt : 'module_type) _ (m : string) (loc : int * int) ->
+        (fun (mt : 'module_type) _ (m : string)
+           (loc : Lexing.position * Lexing.position) ->
            (m, mt : 'module_rec_declaration))]];
     Grammar.Entry.obj (with_constr : 'with_constr Grammar.Entry.e), None,
     [None, None,
@@ -674,7 +704,8 @@ Grammar.extend
        Gramext.Snterm
          (Grammar.Entry.obj (module_expr : 'module_expr Grammar.Entry.e))],
       Gramext.action
-        (fun (me : 'module_expr) _ (i : 'mod_ident) _ (loc : int * int) ->
+        (fun (me : 'module_expr) _ (i : 'mod_ident) _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.WcMod (loc, i, me) : 'with_constr));
       [Gramext.Stoken ("", "type");
        Gramext.Snterm
@@ -687,17 +718,31 @@ Grammar.extend
        Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))],
       Gramext.action
         (fun (t : 'ctyp) _ (tpl : 'type_parameter list) (i : 'mod_ident) _
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.WcTyp (loc, i, tpl, t) : 'with_constr))]];
     Grammar.Entry.obj (expr : 'expr Grammar.Entry.e), None,
     [Some "top", Some Gramext.RightA,
-     [[Gramext.Stoken ("", "while"); Gramext.Sself; Gramext.Stoken ("", "do");
+     [[Gramext.Stoken ("", "object");
+       Gramext.Sopt
+         (Gramext.Snterm
+            (Grammar.Entry.obj
+               (class_self_patt : 'class_self_patt Grammar.Entry.e)));
+       Gramext.Snterm
+         (Grammar.Entry.obj
+            (class_structure : 'class_structure Grammar.Entry.e));
+       Gramext.Stoken ("", "end")],
+      Gramext.action
+        (fun _ (cf : 'class_structure) (cspo : 'class_self_patt option) _
+           (loc : Lexing.position * Lexing.position) ->
+           (MLast.ExObj (loc, cspo, cf) : 'expr));
+      [Gramext.Stoken ("", "while"); Gramext.Sself; Gramext.Stoken ("", "do");
        Gramext.Stoken ("", "{");
        Gramext.Snterm
          (Grammar.Entry.obj (sequence : 'sequence Grammar.Entry.e));
        Gramext.Stoken ("", "}")],
       Gramext.action
-        (fun _ (seq : 'sequence) _ _ (e : 'expr) _ (loc : int * int) ->
+        (fun _ (seq : 'sequence) _ _ (e : 'expr) _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExWhi (loc, e, seq) : 'expr));
       [Gramext.Stoken ("", "for"); Gramext.Stoken ("LIDENT", "");
        Gramext.Stoken ("", "="); Gramext.Sself;
@@ -710,25 +755,29 @@ Grammar.extend
        Gramext.Stoken ("", "}")],
       Gramext.action
         (fun _ (seq : 'sequence) _ _ (e2 : 'expr) (df : 'direction_flag)
-           (e1 : 'expr) _ (i : string) _ (loc : int * int) ->
+           (e1 : 'expr) _ (i : string) _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExFor (loc, i, e1, e2, df, seq) : 'expr));
       [Gramext.Stoken ("", "do"); Gramext.Stoken ("", "{");
        Gramext.Snterm
          (Grammar.Entry.obj (sequence : 'sequence Grammar.Entry.e));
        Gramext.Stoken ("", "}")],
       Gramext.action
-        (fun _ (seq : 'sequence) _ _ (loc : int * int) ->
+        (fun _ (seq : 'sequence) _ _
+           (loc : Lexing.position * Lexing.position) ->
            (mksequence loc seq : 'expr));
       [Gramext.Stoken ("", "if"); Gramext.Sself; Gramext.Stoken ("", "then");
        Gramext.Sself; Gramext.Stoken ("", "else"); Gramext.Sself],
       Gramext.action
-        (fun (e3 : 'expr) _ (e2 : 'expr) _ (e1 : 'expr) _ (loc : int * int) ->
+        (fun (e3 : 'expr) _ (e2 : 'expr) _ (e1 : 'expr) _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExIfe (loc, e1, e2, e3) : 'expr));
       [Gramext.Stoken ("", "try"); Gramext.Sself; Gramext.Stoken ("", "with");
        Gramext.Snterm (Grammar.Entry.obj (ipatt : 'ipatt Grammar.Entry.e));
        Gramext.Stoken ("", "->"); Gramext.Sself],
       Gramext.action
-        (fun (e1 : 'expr) _ (p1 : 'ipatt) _ (e : 'expr) _ (loc : int * int) ->
+        (fun (e1 : 'expr) _ (p1 : 'ipatt) _ (e : 'expr) _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExTry (loc, e, [p1, None, e1]) : 'expr));
       [Gramext.Stoken ("", "try"); Gramext.Sself; Gramext.Stoken ("", "with");
        Gramext.Stoken ("", "[");
@@ -738,14 +787,16 @@ Grammar.extend
           Gramext.Stoken ("", "|"));
        Gramext.Stoken ("", "]")],
       Gramext.action
-        (fun _ (l : 'match_case list) _ _ (e : 'expr) _ (loc : int * int) ->
+        (fun _ (l : 'match_case list) _ _ (e : 'expr) _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExTry (loc, e, l) : 'expr));
       [Gramext.Stoken ("", "match"); Gramext.Sself;
        Gramext.Stoken ("", "with");
        Gramext.Snterm (Grammar.Entry.obj (ipatt : 'ipatt Grammar.Entry.e));
        Gramext.Stoken ("", "->"); Gramext.Sself],
       Gramext.action
-        (fun (e1 : 'expr) _ (p1 : 'ipatt) _ (e : 'expr) _ (loc : int * int) ->
+        (fun (e1 : 'expr) _ (p1 : 'ipatt) _ (e : 'expr) _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExMat (loc, e, [p1, None, e1]) : 'expr));
       [Gramext.Stoken ("", "match"); Gramext.Sself;
        Gramext.Stoken ("", "with"); Gramext.Stoken ("", "[");
@@ -755,14 +806,16 @@ Grammar.extend
           Gramext.Stoken ("", "|"));
        Gramext.Stoken ("", "]")],
       Gramext.action
-        (fun _ (l : 'match_case list) _ _ (e : 'expr) _ (loc : int * int) ->
+        (fun _ (l : 'match_case list) _ _ (e : 'expr) _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExMat (loc, e, l) : 'expr));
       [Gramext.Stoken ("", "fun");
        Gramext.Snterm (Grammar.Entry.obj (ipatt : 'ipatt Grammar.Entry.e));
        Gramext.Snterm
          (Grammar.Entry.obj (fun_def : 'fun_def Grammar.Entry.e))],
       Gramext.action
-        (fun (e : 'fun_def) (p : 'ipatt) _ (loc : int * int) ->
+        (fun (e : 'fun_def) (p : 'ipatt) _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExFun (loc, [p, None, e]) : 'expr));
       [Gramext.Stoken ("", "fun"); Gramext.Stoken ("", "[");
        Gramext.Slist0sep
@@ -771,7 +824,8 @@ Grammar.extend
           Gramext.Stoken ("", "|"));
        Gramext.Stoken ("", "]")],
       Gramext.action
-        (fun _ (l : 'match_case list) _ _ (loc : int * int) ->
+        (fun _ (l : 'match_case list) _ _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExFun (loc, l) : 'expr));
       [Gramext.Stoken ("", "let"); Gramext.Stoken ("", "module");
        Gramext.Stoken ("UIDENT", "");
@@ -781,7 +835,7 @@ Grammar.extend
        Gramext.Stoken ("", "in"); Gramext.Sself],
       Gramext.action
         (fun (e : 'expr) _ (mb : 'module_binding) (m : string) _ _
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExLmd (loc, m, mb, e) : 'expr));
       [Gramext.Stoken ("", "let"); Gramext.Sopt (Gramext.Stoken ("", "rec"));
        Gramext.Slist1sep
@@ -791,7 +845,7 @@ Grammar.extend
        Gramext.Stoken ("", "in"); Gramext.Sself],
       Gramext.action
         (fun (x : 'expr) _ (l : 'let_binding list) (r : string option) _
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExLet (loc, o2b r, l, x) : 'expr))];
      Some "where", None,
      [[Gramext.Sself; Gramext.Stoken ("", "where");
@@ -800,252 +854,293 @@ Grammar.extend
          (Grammar.Entry.obj (let_binding : 'let_binding Grammar.Entry.e))],
       Gramext.action
         (fun (lb : 'let_binding) (rf : string option) _ (e : 'expr)
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExLet (loc, o2b rf, [lb], e) : 'expr))];
      Some ":=", Some Gramext.NonA,
      [[Gramext.Sself; Gramext.Stoken ("", ":="); Gramext.Sself;
        Gramext.Snterm (Grammar.Entry.obj (dummy : 'dummy Grammar.Entry.e))],
       Gramext.action
-        (fun _ (e2 : 'expr) _ (e1 : 'expr) (loc : int * int) ->
+        (fun _ (e2 : 'expr) _ (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExAss (loc, e1, e2) : 'expr))];
      Some "||", Some Gramext.RightA,
      [[Gramext.Sself; Gramext.Stoken ("", "||"); Gramext.Sself],
       Gramext.action
-        (fun (e2 : 'expr) _ (e1 : 'expr) (loc : int * int) ->
+        (fun (e2 : 'expr) _ (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExApp
               (loc, MLast.ExApp (loc, MLast.ExLid (loc, "||"), e1), e2) :
             'expr))];
      Some "&&", Some Gramext.RightA,
      [[Gramext.Sself; Gramext.Stoken ("", "&&"); Gramext.Sself],
       Gramext.action
-        (fun (e2 : 'expr) _ (e1 : 'expr) (loc : int * int) ->
+        (fun (e2 : 'expr) _ (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExApp
               (loc, MLast.ExApp (loc, MLast.ExLid (loc, "&&"), e1), e2) :
             'expr))];
      Some "<", Some Gramext.LeftA,
      [[Gramext.Sself; Gramext.Stoken ("", "!="); Gramext.Sself],
       Gramext.action
-        (fun (e2 : 'expr) _ (e1 : 'expr) (loc : int * int) ->
+        (fun (e2 : 'expr) _ (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExApp
               (loc, MLast.ExApp (loc, MLast.ExLid (loc, "!="), e1), e2) :
             'expr));
       [Gramext.Sself; Gramext.Stoken ("", "=="); Gramext.Sself],
       Gramext.action
-        (fun (e2 : 'expr) _ (e1 : 'expr) (loc : int * int) ->
+        (fun (e2 : 'expr) _ (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExApp
               (loc, MLast.ExApp (loc, MLast.ExLid (loc, "=="), e1), e2) :
             'expr));
       [Gramext.Sself; Gramext.Stoken ("", "<>"); Gramext.Sself],
       Gramext.action
-        (fun (e2 : 'expr) _ (e1 : 'expr) (loc : int * int) ->
+        (fun (e2 : 'expr) _ (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExApp
               (loc, MLast.ExApp (loc, MLast.ExLid (loc, "<>"), e1), e2) :
             'expr));
       [Gramext.Sself; Gramext.Stoken ("", "="); Gramext.Sself],
       Gramext.action
-        (fun (e2 : 'expr) _ (e1 : 'expr) (loc : int * int) ->
+        (fun (e2 : 'expr) _ (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExApp
               (loc, MLast.ExApp (loc, MLast.ExLid (loc, "="), e1), e2) :
             'expr));
       [Gramext.Sself; Gramext.Stoken ("", ">="); Gramext.Sself],
       Gramext.action
-        (fun (e2 : 'expr) _ (e1 : 'expr) (loc : int * int) ->
+        (fun (e2 : 'expr) _ (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExApp
               (loc, MLast.ExApp (loc, MLast.ExLid (loc, ">="), e1), e2) :
             'expr));
       [Gramext.Sself; Gramext.Stoken ("", "<="); Gramext.Sself],
       Gramext.action
-        (fun (e2 : 'expr) _ (e1 : 'expr) (loc : int * int) ->
+        (fun (e2 : 'expr) _ (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExApp
               (loc, MLast.ExApp (loc, MLast.ExLid (loc, "<="), e1), e2) :
             'expr));
       [Gramext.Sself; Gramext.Stoken ("", ">"); Gramext.Sself],
       Gramext.action
-        (fun (e2 : 'expr) _ (e1 : 'expr) (loc : int * int) ->
+        (fun (e2 : 'expr) _ (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExApp
               (loc, MLast.ExApp (loc, MLast.ExLid (loc, ">"), e1), e2) :
             'expr));
       [Gramext.Sself; Gramext.Stoken ("", "<"); Gramext.Sself],
       Gramext.action
-        (fun (e2 : 'expr) _ (e1 : 'expr) (loc : int * int) ->
+        (fun (e2 : 'expr) _ (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExApp
               (loc, MLast.ExApp (loc, MLast.ExLid (loc, "<"), e1), e2) :
             'expr))];
      Some "^", Some Gramext.RightA,
      [[Gramext.Sself; Gramext.Stoken ("", "@"); Gramext.Sself],
       Gramext.action
-        (fun (e2 : 'expr) _ (e1 : 'expr) (loc : int * int) ->
+        (fun (e2 : 'expr) _ (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExApp
               (loc, MLast.ExApp (loc, MLast.ExLid (loc, "@"), e1), e2) :
             'expr));
       [Gramext.Sself; Gramext.Stoken ("", "^"); Gramext.Sself],
       Gramext.action
-        (fun (e2 : 'expr) _ (e1 : 'expr) (loc : int * int) ->
+        (fun (e2 : 'expr) _ (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExApp
               (loc, MLast.ExApp (loc, MLast.ExLid (loc, "^"), e1), e2) :
             'expr))];
      Some "+", Some Gramext.LeftA,
      [[Gramext.Sself; Gramext.Stoken ("", "-."); Gramext.Sself],
       Gramext.action
-        (fun (e2 : 'expr) _ (e1 : 'expr) (loc : int * int) ->
+        (fun (e2 : 'expr) _ (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExApp
               (loc, MLast.ExApp (loc, MLast.ExLid (loc, "-."), e1), e2) :
             'expr));
       [Gramext.Sself; Gramext.Stoken ("", "+."); Gramext.Sself],
       Gramext.action
-        (fun (e2 : 'expr) _ (e1 : 'expr) (loc : int * int) ->
+        (fun (e2 : 'expr) _ (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExApp
               (loc, MLast.ExApp (loc, MLast.ExLid (loc, "+."), e1), e2) :
             'expr));
       [Gramext.Sself; Gramext.Stoken ("", "-"); Gramext.Sself],
       Gramext.action
-        (fun (e2 : 'expr) _ (e1 : 'expr) (loc : int * int) ->
+        (fun (e2 : 'expr) _ (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExApp
               (loc, MLast.ExApp (loc, MLast.ExLid (loc, "-"), e1), e2) :
             'expr));
       [Gramext.Sself; Gramext.Stoken ("", "+"); Gramext.Sself],
       Gramext.action
-        (fun (e2 : 'expr) _ (e1 : 'expr) (loc : int * int) ->
+        (fun (e2 : 'expr) _ (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExApp
               (loc, MLast.ExApp (loc, MLast.ExLid (loc, "+"), e1), e2) :
             'expr))];
      Some "*", Some Gramext.LeftA,
      [[Gramext.Sself; Gramext.Stoken ("", "mod"); Gramext.Sself],
       Gramext.action
-        (fun (e2 : 'expr) _ (e1 : 'expr) (loc : int * int) ->
+        (fun (e2 : 'expr) _ (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExApp
               (loc, MLast.ExApp (loc, MLast.ExLid (loc, "mod"), e1), e2) :
             'expr));
       [Gramext.Sself; Gramext.Stoken ("", "lxor"); Gramext.Sself],
       Gramext.action
-        (fun (e2 : 'expr) _ (e1 : 'expr) (loc : int * int) ->
+        (fun (e2 : 'expr) _ (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExApp
               (loc, MLast.ExApp (loc, MLast.ExLid (loc, "lxor"), e1), e2) :
             'expr));
       [Gramext.Sself; Gramext.Stoken ("", "lor"); Gramext.Sself],
       Gramext.action
-        (fun (e2 : 'expr) _ (e1 : 'expr) (loc : int * int) ->
+        (fun (e2 : 'expr) _ (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExApp
               (loc, MLast.ExApp (loc, MLast.ExLid (loc, "lor"), e1), e2) :
             'expr));
       [Gramext.Sself; Gramext.Stoken ("", "land"); Gramext.Sself],
       Gramext.action
-        (fun (e2 : 'expr) _ (e1 : 'expr) (loc : int * int) ->
+        (fun (e2 : 'expr) _ (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExApp
               (loc, MLast.ExApp (loc, MLast.ExLid (loc, "land"), e1), e2) :
             'expr));
       [Gramext.Sself; Gramext.Stoken ("", "/."); Gramext.Sself],
       Gramext.action
-        (fun (e2 : 'expr) _ (e1 : 'expr) (loc : int * int) ->
+        (fun (e2 : 'expr) _ (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExApp
               (loc, MLast.ExApp (loc, MLast.ExLid (loc, "/."), e1), e2) :
             'expr));
       [Gramext.Sself; Gramext.Stoken ("", "*."); Gramext.Sself],
       Gramext.action
-        (fun (e2 : 'expr) _ (e1 : 'expr) (loc : int * int) ->
+        (fun (e2 : 'expr) _ (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExApp
               (loc, MLast.ExApp (loc, MLast.ExLid (loc, "*."), e1), e2) :
             'expr));
       [Gramext.Sself; Gramext.Stoken ("", "/"); Gramext.Sself],
       Gramext.action
-        (fun (e2 : 'expr) _ (e1 : 'expr) (loc : int * int) ->
+        (fun (e2 : 'expr) _ (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExApp
               (loc, MLast.ExApp (loc, MLast.ExLid (loc, "/"), e1), e2) :
             'expr));
       [Gramext.Sself; Gramext.Stoken ("", "*"); Gramext.Sself],
       Gramext.action
-        (fun (e2 : 'expr) _ (e1 : 'expr) (loc : int * int) ->
+        (fun (e2 : 'expr) _ (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExApp
               (loc, MLast.ExApp (loc, MLast.ExLid (loc, "*"), e1), e2) :
             'expr))];
      Some "**", Some Gramext.RightA,
      [[Gramext.Sself; Gramext.Stoken ("", "lsr"); Gramext.Sself],
       Gramext.action
-        (fun (e2 : 'expr) _ (e1 : 'expr) (loc : int * int) ->
+        (fun (e2 : 'expr) _ (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExApp
               (loc, MLast.ExApp (loc, MLast.ExLid (loc, "lsr"), e1), e2) :
             'expr));
       [Gramext.Sself; Gramext.Stoken ("", "lsl"); Gramext.Sself],
       Gramext.action
-        (fun (e2 : 'expr) _ (e1 : 'expr) (loc : int * int) ->
+        (fun (e2 : 'expr) _ (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExApp
               (loc, MLast.ExApp (loc, MLast.ExLid (loc, "lsl"), e1), e2) :
             'expr));
       [Gramext.Sself; Gramext.Stoken ("", "asr"); Gramext.Sself],
       Gramext.action
-        (fun (e2 : 'expr) _ (e1 : 'expr) (loc : int * int) ->
+        (fun (e2 : 'expr) _ (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExApp
               (loc, MLast.ExApp (loc, MLast.ExLid (loc, "asr"), e1), e2) :
             'expr));
       [Gramext.Sself; Gramext.Stoken ("", "**"); Gramext.Sself],
       Gramext.action
-        (fun (e2 : 'expr) _ (e1 : 'expr) (loc : int * int) ->
+        (fun (e2 : 'expr) _ (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExApp
               (loc, MLast.ExApp (loc, MLast.ExLid (loc, "**"), e1), e2) :
             'expr))];
      Some "unary minus", Some Gramext.NonA,
      [[Gramext.Stoken ("", "-."); Gramext.Sself],
       Gramext.action
-        (fun (e : 'expr) _ (loc : int * int) -> (mkumin loc "-." e : 'expr));
+        (fun (e : 'expr) _ (loc : Lexing.position * Lexing.position) ->
+           (mkumin loc "-." e : 'expr));
       [Gramext.Stoken ("", "-"); Gramext.Sself],
       Gramext.action
-        (fun (e : 'expr) _ (loc : int * int) -> (mkumin loc "-" e : 'expr))];
+        (fun (e : 'expr) _ (loc : Lexing.position * Lexing.position) ->
+           (mkumin loc "-" e : 'expr))];
      Some "apply", Some Gramext.LeftA,
      [[Gramext.Stoken ("", "lazy"); Gramext.Sself],
       Gramext.action
-        (fun (e : 'expr) _ (loc : int * int) ->
+        (fun (e : 'expr) _ (loc : Lexing.position * Lexing.position) ->
            (MLast.ExLaz (loc, e) : 'expr));
       [Gramext.Stoken ("", "assert"); Gramext.Sself],
       Gramext.action
-        (fun (e : 'expr) _ (loc : int * int) -> (mkassert loc e : 'expr));
+        (fun (e : 'expr) _ (loc : Lexing.position * Lexing.position) ->
+           (mkassert loc e : 'expr));
       [Gramext.Sself; Gramext.Sself],
       Gramext.action
-        (fun (e2 : 'expr) (e1 : 'expr) (loc : int * int) ->
+        (fun (e2 : 'expr) (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExApp (loc, e1, e2) : 'expr))];
      Some ".", Some Gramext.LeftA,
      [[Gramext.Sself; Gramext.Stoken ("", "."); Gramext.Sself],
       Gramext.action
-        (fun (e2 : 'expr) _ (e1 : 'expr) (loc : int * int) ->
+        (fun (e2 : 'expr) _ (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExAcc (loc, e1, e2) : 'expr));
       [Gramext.Sself; Gramext.Stoken ("", "."); Gramext.Stoken ("", "[");
        Gramext.Sself; Gramext.Stoken ("", "]")],
       Gramext.action
-        (fun _ (e2 : 'expr) _ _ (e1 : 'expr) (loc : int * int) ->
+        (fun _ (e2 : 'expr) _ _ (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExSte (loc, e1, e2) : 'expr));
       [Gramext.Sself; Gramext.Stoken ("", "."); Gramext.Stoken ("", "(");
        Gramext.Sself; Gramext.Stoken ("", ")")],
       Gramext.action
-        (fun _ (e2 : 'expr) _ _ (e1 : 'expr) (loc : int * int) ->
+        (fun _ (e2 : 'expr) _ _ (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExAre (loc, e1, e2) : 'expr))];
      Some "~-", Some Gramext.NonA,
      [[Gramext.Stoken ("", "~-."); Gramext.Sself],
       Gramext.action
-        (fun (e : 'expr) _ (loc : int * int) ->
+        (fun (e : 'expr) _ (loc : Lexing.position * Lexing.position) ->
            (MLast.ExApp (loc, MLast.ExLid (loc, "~-."), e) : 'expr));
       [Gramext.Stoken ("", "~-"); Gramext.Sself],
       Gramext.action
-        (fun (e : 'expr) _ (loc : int * int) ->
+        (fun (e : 'expr) _ (loc : Lexing.position * Lexing.position) ->
            (MLast.ExApp (loc, MLast.ExLid (loc, "~-"), e) : 'expr))];
      Some "simple", None,
      [[Gramext.Stoken ("", "("); Gramext.Sself; Gramext.Stoken ("", ")")],
-      Gramext.action (fun _ (e : 'expr) _ (loc : int * int) -> (e : 'expr));
+      Gramext.action
+        (fun _ (e : 'expr) _ (loc : Lexing.position * Lexing.position) ->
+           (e : 'expr));
       [Gramext.Stoken ("", "("); Gramext.Sself; Gramext.Stoken ("", ",");
        Gramext.Slist1sep
          (Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e)),
           Gramext.Stoken ("", ","));
        Gramext.Stoken ("", ")")],
       Gramext.action
-        (fun _ (el : 'expr list) _ (e : 'expr) _ (loc : int * int) ->
+        (fun _ (el : 'expr list) _ (e : 'expr) _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExTup (loc, (e :: el)) : 'expr));
       [Gramext.Stoken ("", "("); Gramext.Sself; Gramext.Stoken ("", ":");
        Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e));
        Gramext.Stoken ("", ")")],
       Gramext.action
-        (fun _ (t : 'ctyp) _ (e : 'expr) _ (loc : int * int) ->
+        (fun _ (t : 'ctyp) _ (e : 'expr) _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExTyc (loc, e, t) : 'expr));
       [Gramext.Stoken ("", "("); Gramext.Stoken ("", ")")],
       Gramext.action
-        (fun _ _ (loc : int * int) -> (MLast.ExUid (loc, "()") : 'expr));
+        (fun _ _ (loc : Lexing.position * Lexing.position) ->
+           (MLast.ExUid (loc, "()") : 'expr));
       [Gramext.Stoken ("", "{"); Gramext.Stoken ("", "("); Gramext.Sself;
        Gramext.Stoken ("", ")"); Gramext.Stoken ("", "with");
        Gramext.Slist1sep
@@ -1055,7 +1150,7 @@ Grammar.extend
        Gramext.Stoken ("", "}")],
       Gramext.action
         (fun _ (lel : 'label_expr list) _ _ (e : 'expr) _ _
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExRec (loc, lel, Some e) : 'expr));
       [Gramext.Stoken ("", "{");
        Gramext.Slist1sep
@@ -1064,7 +1159,8 @@ Grammar.extend
           Gramext.Stoken ("", ";"));
        Gramext.Stoken ("", "}")],
       Gramext.action
-        (fun _ (lel : 'label_expr list) _ (loc : int * int) ->
+        (fun _ (lel : 'label_expr list) _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExRec (loc, lel, None) : 'expr));
       [Gramext.Stoken ("", "[|");
        Gramext.Slist0sep
@@ -1072,7 +1168,8 @@ Grammar.extend
           Gramext.Stoken ("", ";"));
        Gramext.Stoken ("", "|]")],
       Gramext.action
-        (fun _ (el : 'expr list) _ (loc : int * int) ->
+        (fun _ (el : 'expr list) _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExArr (loc, el) : 'expr));
       [Gramext.Stoken ("", "[");
        Gramext.Slist1sep
@@ -1083,64 +1180,77 @@ Grammar.extend
        Gramext.Stoken ("", "]")],
       Gramext.action
         (fun _ (last : 'cons_expr_opt) (el : 'expr list) _
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (mklistexp loc last el : 'expr));
       [Gramext.Stoken ("", "["); Gramext.Stoken ("", "]")],
       Gramext.action
-        (fun _ _ (loc : int * int) -> (MLast.ExUid (loc, "[]") : 'expr));
+        (fun _ _ (loc : Lexing.position * Lexing.position) ->
+           (MLast.ExUid (loc, "[]") : 'expr));
       [Gramext.Snterm
          (Grammar.Entry.obj (expr_ident : 'expr_ident Grammar.Entry.e))],
-      Gramext.action (fun (i : 'expr_ident) (loc : int * int) -> (i : 'expr));
+      Gramext.action
+        (fun (i : 'expr_ident) (loc : Lexing.position * Lexing.position) ->
+           (i : 'expr));
       [Gramext.Stoken ("CHAR", "")],
       Gramext.action
-        (fun (s : string) (loc : int * int) ->
+        (fun (s : string) (loc : Lexing.position * Lexing.position) ->
            (MLast.ExChr (loc, s) : 'expr));
       [Gramext.Stoken ("STRING", "")],
       Gramext.action
-        (fun (s : string) (loc : int * int) ->
+        (fun (s : string) (loc : Lexing.position * Lexing.position) ->
            (MLast.ExStr (loc, s) : 'expr));
       [Gramext.Stoken ("FLOAT", "")],
       Gramext.action
-        (fun (s : string) (loc : int * int) ->
+        (fun (s : string) (loc : Lexing.position * Lexing.position) ->
            (MLast.ExFlo (loc, s) : 'expr));
       [Gramext.Stoken ("NATIVEINT", "")],
       Gramext.action
-        (fun (s : string) (loc : int * int) ->
+        (fun (s : string) (loc : Lexing.position * Lexing.position) ->
            (MLast.ExNativeInt (loc, s) : 'expr));
       [Gramext.Stoken ("INT64", "")],
       Gramext.action
-        (fun (s : string) (loc : int * int) ->
+        (fun (s : string) (loc : Lexing.position * Lexing.position) ->
            (MLast.ExInt64 (loc, s) : 'expr));
       [Gramext.Stoken ("INT32", "")],
       Gramext.action
-        (fun (s : string) (loc : int * int) ->
+        (fun (s : string) (loc : Lexing.position * Lexing.position) ->
            (MLast.ExInt32 (loc, s) : 'expr));
       [Gramext.Stoken ("INT", "")],
       Gramext.action
-        (fun (s : string) (loc : int * int) ->
+        (fun (s : string) (loc : Lexing.position * Lexing.position) ->
            (MLast.ExInt (loc, s) : 'expr))]];
     Grammar.Entry.obj (cons_expr_opt : 'cons_expr_opt Grammar.Entry.e), None,
     [None, None,
-     [[], Gramext.action (fun (loc : int * int) -> (None : 'cons_expr_opt));
+     [[],
+      Gramext.action
+        (fun (loc : Lexing.position * Lexing.position) ->
+           (None : 'cons_expr_opt));
       [Gramext.Stoken ("", "::");
        Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))],
       Gramext.action
-        (fun (e : 'expr) _ (loc : int * int) -> (Some e : 'cons_expr_opt))]];
+        (fun (e : 'expr) _ (loc : Lexing.position * Lexing.position) ->
+           (Some e : 'cons_expr_opt))]];
     Grammar.Entry.obj (dummy : 'dummy Grammar.Entry.e), None,
     [None, None,
-     [[], Gramext.action (fun (loc : int * int) -> (() : 'dummy))]];
+     [[],
+      Gramext.action
+        (fun (loc : Lexing.position * Lexing.position) -> (() : 'dummy))]];
     Grammar.Entry.obj (sequence : 'sequence Grammar.Entry.e), None,
     [None, None,
      [[Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))],
-      Gramext.action (fun (e : 'expr) (loc : int * int) -> ([e] : 'sequence));
+      Gramext.action
+        (fun (e : 'expr) (loc : Lexing.position * Lexing.position) ->
+           ([e] : 'sequence));
       [Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e));
        Gramext.Stoken ("", ";")],
       Gramext.action
-        (fun _ (e : 'expr) (loc : int * int) -> ([e] : 'sequence));
+        (fun _ (e : 'expr) (loc : Lexing.position * Lexing.position) ->
+           ([e] : 'sequence));
       [Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e));
        Gramext.Stoken ("", ";"); Gramext.Sself],
       Gramext.action
-        (fun (el : 'sequence) _ (e : 'expr) (loc : int * int) ->
+        (fun (el : 'sequence) _ (e : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (e :: el : 'sequence));
       [Gramext.Stoken ("", "let"); Gramext.Sopt (Gramext.Stoken ("", "rec"));
        Gramext.Slist1sep
@@ -1149,13 +1259,17 @@ Grammar.extend
           Gramext.Stoken ("", "and"));
        Gramext.srules
          [[Gramext.Stoken ("", ";")],
-          Gramext.action (fun (x : string) (loc : int * int) -> (x : 'e__5));
+          Gramext.action
+            (fun (x : string) (loc : Lexing.position * Lexing.position) ->
+               (x : 'e__5));
           [Gramext.Stoken ("", "in")],
-          Gramext.action (fun (x : string) (loc : int * int) -> (x : 'e__5))];
+          Gramext.action
+            (fun (x : string) (loc : Lexing.position * Lexing.position) ->
+               (x : 'e__5))];
        Gramext.Sself],
       Gramext.action
         (fun (el : 'sequence) _ (l : 'let_binding list) (rf : string option) _
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            ([MLast.ExLet (loc, o2b rf, l, mksequence loc el)] : 'sequence))]];
     Grammar.Entry.obj (let_binding : 'let_binding Grammar.Entry.e), None,
     [None, None,
@@ -1163,7 +1277,8 @@ Grammar.extend
        Gramext.Snterm
          (Grammar.Entry.obj (fun_binding : 'fun_binding Grammar.Entry.e))],
       Gramext.action
-        (fun (e : 'fun_binding) (p : 'ipatt) (loc : int * int) ->
+        (fun (e : 'fun_binding) (p : 'ipatt)
+           (loc : Lexing.position * Lexing.position) ->
            (p, e : 'let_binding))]];
     Grammar.Entry.obj (fun_binding : 'fun_binding Grammar.Entry.e), None,
     [None, Some Gramext.RightA,
@@ -1172,16 +1287,19 @@ Grammar.extend
        Gramext.Stoken ("", "=");
        Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))],
       Gramext.action
-        (fun (e : 'expr) _ (t : 'ctyp) _ (loc : int * int) ->
+        (fun (e : 'expr) _ (t : 'ctyp) _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExTyc (loc, e, t) : 'fun_binding));
       [Gramext.Stoken ("", "=");
        Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))],
       Gramext.action
-        (fun (e : 'expr) _ (loc : int * int) -> (e : 'fun_binding));
+        (fun (e : 'expr) _ (loc : Lexing.position * Lexing.position) ->
+           (e : 'fun_binding));
       [Gramext.Snterm (Grammar.Entry.obj (ipatt : 'ipatt Grammar.Entry.e));
        Gramext.Sself],
       Gramext.action
-        (fun (e : 'fun_binding) (p : 'ipatt) (loc : int * int) ->
+        (fun (e : 'fun_binding) (p : 'ipatt)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExFun (loc, [p, None, e]) : 'fun_binding))]];
     Grammar.Entry.obj (match_case : 'match_case Grammar.Entry.e), None,
     [None, None,
@@ -1194,22 +1312,30 @@ Grammar.extend
        Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))],
       Gramext.action
         (fun (e : 'expr) _ (w : 'when_expr_opt) (aso : 'as_patt_opt)
-           (p : 'patt) (loc : int * int) ->
+           (p : 'patt) (loc : Lexing.position * Lexing.position) ->
            (mkmatchcase loc p aso w e : 'match_case))]];
     Grammar.Entry.obj (as_patt_opt : 'as_patt_opt Grammar.Entry.e), None,
     [None, None,
-     [[], Gramext.action (fun (loc : int * int) -> (None : 'as_patt_opt));
+     [[],
+      Gramext.action
+        (fun (loc : Lexing.position * Lexing.position) ->
+           (None : 'as_patt_opt));
       [Gramext.Stoken ("", "as");
        Gramext.Snterm (Grammar.Entry.obj (patt : 'patt Grammar.Entry.e))],
       Gramext.action
-        (fun (p : 'patt) _ (loc : int * int) -> (Some p : 'as_patt_opt))]];
+        (fun (p : 'patt) _ (loc : Lexing.position * Lexing.position) ->
+           (Some p : 'as_patt_opt))]];
     Grammar.Entry.obj (when_expr_opt : 'when_expr_opt Grammar.Entry.e), None,
     [None, None,
-     [[], Gramext.action (fun (loc : int * int) -> (None : 'when_expr_opt));
+     [[],
+      Gramext.action
+        (fun (loc : Lexing.position * Lexing.position) ->
+           (None : 'when_expr_opt));
       [Gramext.Stoken ("", "when");
        Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))],
       Gramext.action
-        (fun (e : 'expr) _ (loc : int * int) -> (Some e : 'when_expr_opt))]];
+        (fun (e : 'expr) _ (loc : Lexing.position * Lexing.position) ->
+           (Some e : 'when_expr_opt))]];
     Grammar.Entry.obj (label_expr : 'label_expr Grammar.Entry.e), None,
     [None, None,
      [[Gramext.Snterm
@@ -1218,81 +1344,98 @@ Grammar.extend
        Gramext.Snterm
          (Grammar.Entry.obj (fun_binding : 'fun_binding Grammar.Entry.e))],
       Gramext.action
-        (fun (e : 'fun_binding) (i : 'patt_label_ident) (loc : int * int) ->
+        (fun (e : 'fun_binding) (i : 'patt_label_ident)
+           (loc : Lexing.position * Lexing.position) ->
            (i, e : 'label_expr))]];
     Grammar.Entry.obj (expr_ident : 'expr_ident Grammar.Entry.e), None,
     [None, Some Gramext.RightA,
      [[Gramext.Stoken ("UIDENT", ""); Gramext.Stoken ("", ".");
        Gramext.Sself],
       Gramext.action
-        (fun (j : 'expr_ident) _ (i : string) (loc : int * int) ->
+        (fun (j : 'expr_ident) _ (i : string)
+           (loc : Lexing.position * Lexing.position) ->
            (mkexprident loc i j : 'expr_ident));
       [Gramext.Stoken ("UIDENT", "")],
       Gramext.action
-        (fun (i : string) (loc : int * int) ->
+        (fun (i : string) (loc : Lexing.position * Lexing.position) ->
            (MLast.ExUid (loc, i) : 'expr_ident));
       [Gramext.Stoken ("LIDENT", "")],
       Gramext.action
-        (fun (i : string) (loc : int * int) ->
+        (fun (i : string) (loc : Lexing.position * Lexing.position) ->
            (MLast.ExLid (loc, i) : 'expr_ident))]];
     Grammar.Entry.obj (fun_def : 'fun_def Grammar.Entry.e), None,
     [None, Some Gramext.RightA,
      [[Gramext.Stoken ("", "->");
        Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))],
-      Gramext.action (fun (e : 'expr) _ (loc : int * int) -> (e : 'fun_def));
+      Gramext.action
+        (fun (e : 'expr) _ (loc : Lexing.position * Lexing.position) ->
+           (e : 'fun_def));
       [Gramext.Snterm (Grammar.Entry.obj (ipatt : 'ipatt Grammar.Entry.e));
        Gramext.Sself],
       Gramext.action
-        (fun (e : 'fun_def) (p : 'ipatt) (loc : int * int) ->
+        (fun (e : 'fun_def) (p : 'ipatt)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExFun (loc, [p, None, e]) : 'fun_def))]];
     Grammar.Entry.obj (patt : 'patt Grammar.Entry.e), None,
     [None, Some Gramext.LeftA,
      [[Gramext.Sself; Gramext.Stoken ("", "|"); Gramext.Sself],
       Gramext.action
-        (fun (p2 : 'patt) _ (p1 : 'patt) (loc : int * int) ->
+        (fun (p2 : 'patt) _ (p1 : 'patt)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.PaOrp (loc, p1, p2) : 'patt))];
      None, Some Gramext.NonA,
      [[Gramext.Sself; Gramext.Stoken ("", ".."); Gramext.Sself],
       Gramext.action
-        (fun (p2 : 'patt) _ (p1 : 'patt) (loc : int * int) ->
+        (fun (p2 : 'patt) _ (p1 : 'patt)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.PaRng (loc, p1, p2) : 'patt))];
      None, Some Gramext.LeftA,
      [[Gramext.Sself; Gramext.Sself],
       Gramext.action
-        (fun (p2 : 'patt) (p1 : 'patt) (loc : int * int) ->
+        (fun (p2 : 'patt) (p1 : 'patt)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.PaApp (loc, p1, p2) : 'patt))];
      None, Some Gramext.LeftA,
      [[Gramext.Sself; Gramext.Stoken ("", "."); Gramext.Sself],
       Gramext.action
-        (fun (p2 : 'patt) _ (p1 : 'patt) (loc : int * int) ->
+        (fun (p2 : 'patt) _ (p1 : 'patt)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.PaAcc (loc, p1, p2) : 'patt))];
      Some "simple", None,
      [[Gramext.Stoken ("", "_")],
-      Gramext.action (fun _ (loc : int * int) -> (MLast.PaAny loc : 'patt));
+      Gramext.action
+        (fun _ (loc : Lexing.position * Lexing.position) ->
+           (MLast.PaAny loc : 'patt));
       [Gramext.Stoken ("", "("); Gramext.Sself; Gramext.Stoken ("", ",");
        Gramext.Slist1sep
          (Gramext.Snterm (Grammar.Entry.obj (patt : 'patt Grammar.Entry.e)),
           Gramext.Stoken ("", ","));
        Gramext.Stoken ("", ")")],
       Gramext.action
-        (fun _ (pl : 'patt list) _ (p : 'patt) _ (loc : int * int) ->
+        (fun _ (pl : 'patt list) _ (p : 'patt) _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.PaTup (loc, (p :: pl)) : 'patt));
       [Gramext.Stoken ("", "("); Gramext.Sself; Gramext.Stoken ("", "as");
        Gramext.Sself; Gramext.Stoken ("", ")")],
       Gramext.action
-        (fun _ (p2 : 'patt) _ (p : 'patt) _ (loc : int * int) ->
+        (fun _ (p2 : 'patt) _ (p : 'patt) _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.PaAli (loc, p, p2) : 'patt));
       [Gramext.Stoken ("", "("); Gramext.Sself; Gramext.Stoken ("", ":");
        Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e));
        Gramext.Stoken ("", ")")],
       Gramext.action
-        (fun _ (t : 'ctyp) _ (p : 'patt) _ (loc : int * int) ->
+        (fun _ (t : 'ctyp) _ (p : 'patt) _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.PaTyc (loc, p, t) : 'patt));
       [Gramext.Stoken ("", "("); Gramext.Sself; Gramext.Stoken ("", ")")],
-      Gramext.action (fun _ (p : 'patt) _ (loc : int * int) -> (p : 'patt));
+      Gramext.action
+        (fun _ (p : 'patt) _ (loc : Lexing.position * Lexing.position) ->
+           (p : 'patt));
       [Gramext.Stoken ("", "("); Gramext.Stoken ("", ")")],
       Gramext.action
-        (fun _ _ (loc : int * int) -> (MLast.PaUid (loc, "()") : 'patt));
+        (fun _ _ (loc : Lexing.position * Lexing.position) ->
+           (MLast.PaUid (loc, "()") : 'patt));
       [Gramext.Stoken ("", "{");
        Gramext.Slist1sep
          (Gramext.Snterm
@@ -1300,7 +1443,8 @@ Grammar.extend
           Gramext.Stoken ("", ";"));
        Gramext.Stoken ("", "}")],
       Gramext.action
-        (fun _ (lpl : 'label_patt list) _ (loc : int * int) ->
+        (fun _ (lpl : 'label_patt list) _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.PaRec (loc, lpl) : 'patt));
       [Gramext.Stoken ("", "[|");
        Gramext.Slist0sep
@@ -1308,7 +1452,8 @@ Grammar.extend
           Gramext.Stoken ("", ";"));
        Gramext.Stoken ("", "|]")],
       Gramext.action
-        (fun _ (pl : 'patt list) _ (loc : int * int) ->
+        (fun _ (pl : 'patt list) _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.PaArr (loc, pl) : 'patt));
       [Gramext.Stoken ("", "[");
        Gramext.Slist1sep
@@ -1319,74 +1464,79 @@ Grammar.extend
        Gramext.Stoken ("", "]")],
       Gramext.action
         (fun _ (last : 'cons_patt_opt) (pl : 'patt list) _
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (mklistpat loc last pl : 'patt));
       [Gramext.Stoken ("", "["); Gramext.Stoken ("", "]")],
       Gramext.action
-        (fun _ _ (loc : int * int) -> (MLast.PaUid (loc, "[]") : 'patt));
+        (fun _ _ (loc : Lexing.position * Lexing.position) ->
+           (MLast.PaUid (loc, "[]") : 'patt));
       [Gramext.Stoken ("", "-"); Gramext.Stoken ("FLOAT", "")],
       Gramext.action
-        (fun (s : string) _ (loc : int * int) ->
+        (fun (s : string) _ (loc : Lexing.position * Lexing.position) ->
            (MLast.PaFlo (loc, neg_string s) : 'patt));
       [Gramext.Stoken ("", "-"); Gramext.Stoken ("NATIVEINT", "")],
       Gramext.action
-        (fun (s : string) _ (loc : int * int) ->
+        (fun (s : string) _ (loc : Lexing.position * Lexing.position) ->
            (MLast.PaNativeInt (loc, neg_string s) : 'patt));
       [Gramext.Stoken ("", "-"); Gramext.Stoken ("INT64", "")],
       Gramext.action
-        (fun (s : string) _ (loc : int * int) ->
+        (fun (s : string) _ (loc : Lexing.position * Lexing.position) ->
            (MLast.PaInt64 (loc, neg_string s) : 'patt));
       [Gramext.Stoken ("", "-"); Gramext.Stoken ("INT32", "")],
       Gramext.action
-        (fun (s : string) _ (loc : int * int) ->
+        (fun (s : string) _ (loc : Lexing.position * Lexing.position) ->
            (MLast.PaInt32 (loc, neg_string s) : 'patt));
       [Gramext.Stoken ("", "-"); Gramext.Stoken ("INT", "")],
       Gramext.action
-        (fun (s : string) _ (loc : int * int) ->
+        (fun (s : string) _ (loc : Lexing.position * Lexing.position) ->
            (MLast.PaInt (loc, neg_string s) : 'patt));
       [Gramext.Stoken ("CHAR", "")],
       Gramext.action
-        (fun (s : string) (loc : int * int) ->
+        (fun (s : string) (loc : Lexing.position * Lexing.position) ->
            (MLast.PaChr (loc, s) : 'patt));
       [Gramext.Stoken ("STRING", "")],
       Gramext.action
-        (fun (s : string) (loc : int * int) ->
+        (fun (s : string) (loc : Lexing.position * Lexing.position) ->
            (MLast.PaStr (loc, s) : 'patt));
       [Gramext.Stoken ("FLOAT", "")],
       Gramext.action
-        (fun (s : string) (loc : int * int) ->
+        (fun (s : string) (loc : Lexing.position * Lexing.position) ->
            (MLast.PaFlo (loc, s) : 'patt));
       [Gramext.Stoken ("NATIVEINT", "")],
       Gramext.action
-        (fun (s : string) (loc : int * int) ->
+        (fun (s : string) (loc : Lexing.position * Lexing.position) ->
            (MLast.PaNativeInt (loc, s) : 'patt));
       [Gramext.Stoken ("INT64", "")],
       Gramext.action
-        (fun (s : string) (loc : int * int) ->
+        (fun (s : string) (loc : Lexing.position * Lexing.position) ->
            (MLast.PaInt64 (loc, s) : 'patt));
       [Gramext.Stoken ("INT32", "")],
       Gramext.action
-        (fun (s : string) (loc : int * int) ->
+        (fun (s : string) (loc : Lexing.position * Lexing.position) ->
            (MLast.PaInt32 (loc, s) : 'patt));
       [Gramext.Stoken ("INT", "")],
       Gramext.action
-        (fun (s : string) (loc : int * int) ->
+        (fun (s : string) (loc : Lexing.position * Lexing.position) ->
            (MLast.PaInt (loc, s) : 'patt));
       [Gramext.Stoken ("UIDENT", "")],
       Gramext.action
-        (fun (s : string) (loc : int * int) ->
+        (fun (s : string) (loc : Lexing.position * Lexing.position) ->
            (MLast.PaUid (loc, s) : 'patt));
       [Gramext.Stoken ("LIDENT", "")],
       Gramext.action
-        (fun (s : string) (loc : int * int) ->
+        (fun (s : string) (loc : Lexing.position * Lexing.position) ->
            (MLast.PaLid (loc, s) : 'patt))]];
     Grammar.Entry.obj (cons_patt_opt : 'cons_patt_opt Grammar.Entry.e), None,
     [None, None,
-     [[], Gramext.action (fun (loc : int * int) -> (None : 'cons_patt_opt));
+     [[],
+      Gramext.action
+        (fun (loc : Lexing.position * Lexing.position) ->
+           (None : 'cons_patt_opt));
       [Gramext.Stoken ("", "::");
        Gramext.Snterm (Grammar.Entry.obj (patt : 'patt Grammar.Entry.e))],
       Gramext.action
-        (fun (p : 'patt) _ (loc : int * int) -> (Some p : 'cons_patt_opt))]];
+        (fun (p : 'patt) _ (loc : Lexing.position * Lexing.position) ->
+           (Some p : 'cons_patt_opt))]];
     Grammar.Entry.obj (label_patt : 'label_patt Grammar.Entry.e), None,
     [None, None,
      [[Gramext.Snterm
@@ -1395,7 +1545,8 @@ Grammar.extend
        Gramext.Stoken ("", "=");
        Gramext.Snterm (Grammar.Entry.obj (patt : 'patt Grammar.Entry.e))],
       Gramext.action
-        (fun (p : 'patt) _ (i : 'patt_label_ident) (loc : int * int) ->
+        (fun (p : 'patt) _ (i : 'patt_label_ident)
+           (loc : Lexing.position * Lexing.position) ->
            (i, p : 'label_patt))]];
     Grammar.Entry.obj (patt_label_ident : 'patt_label_ident Grammar.Entry.e),
     None,
@@ -1403,24 +1554,26 @@ Grammar.extend
      [[Gramext.Sself; Gramext.Stoken ("", "."); Gramext.Sself],
       Gramext.action
         (fun (p2 : 'patt_label_ident) _ (p1 : 'patt_label_ident)
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.PaAcc (loc, p1, p2) : 'patt_label_ident))];
      Some "simple", Some Gramext.RightA,
      [[Gramext.Stoken ("LIDENT", "")],
       Gramext.action
-        (fun (i : string) (loc : int * int) ->
+        (fun (i : string) (loc : Lexing.position * Lexing.position) ->
            (MLast.PaLid (loc, i) : 'patt_label_ident));
       [Gramext.Stoken ("UIDENT", "")],
       Gramext.action
-        (fun (i : string) (loc : int * int) ->
+        (fun (i : string) (loc : Lexing.position * Lexing.position) ->
            (MLast.PaUid (loc, i) : 'patt_label_ident))]];
     Grammar.Entry.obj (ipatt : 'ipatt Grammar.Entry.e), None,
     [None, None,
      [[Gramext.Stoken ("", "_")],
-      Gramext.action (fun _ (loc : int * int) -> (MLast.PaAny loc : 'ipatt));
+      Gramext.action
+        (fun _ (loc : Lexing.position * Lexing.position) ->
+           (MLast.PaAny loc : 'ipatt));
       [Gramext.Stoken ("LIDENT", "")],
       Gramext.action
-        (fun (s : string) (loc : int * int) ->
+        (fun (s : string) (loc : Lexing.position * Lexing.position) ->
            (MLast.PaLid (loc, s) : 'ipatt));
       [Gramext.Stoken ("", "("); Gramext.Sself; Gramext.Stoken ("", ",");
        Gramext.Slist1sep
@@ -1428,24 +1581,30 @@ Grammar.extend
           Gramext.Stoken ("", ","));
        Gramext.Stoken ("", ")")],
       Gramext.action
-        (fun _ (pl : 'ipatt list) _ (p : 'ipatt) _ (loc : int * int) ->
+        (fun _ (pl : 'ipatt list) _ (p : 'ipatt) _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.PaTup (loc, (p :: pl)) : 'ipatt));
       [Gramext.Stoken ("", "("); Gramext.Sself; Gramext.Stoken ("", "as");
        Gramext.Sself; Gramext.Stoken ("", ")")],
       Gramext.action
-        (fun _ (p2 : 'ipatt) _ (p : 'ipatt) _ (loc : int * int) ->
+        (fun _ (p2 : 'ipatt) _ (p : 'ipatt) _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.PaAli (loc, p, p2) : 'ipatt));
       [Gramext.Stoken ("", "("); Gramext.Sself; Gramext.Stoken ("", ":");
        Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e));
        Gramext.Stoken ("", ")")],
       Gramext.action
-        (fun _ (t : 'ctyp) _ (p : 'ipatt) _ (loc : int * int) ->
+        (fun _ (t : 'ctyp) _ (p : 'ipatt) _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.PaTyc (loc, p, t) : 'ipatt));
       [Gramext.Stoken ("", "("); Gramext.Sself; Gramext.Stoken ("", ")")],
-      Gramext.action (fun _ (p : 'ipatt) _ (loc : int * int) -> (p : 'ipatt));
+      Gramext.action
+        (fun _ (p : 'ipatt) _ (loc : Lexing.position * Lexing.position) ->
+           (p : 'ipatt));
       [Gramext.Stoken ("", "("); Gramext.Stoken ("", ")")],
       Gramext.action
-        (fun _ _ (loc : int * int) -> (MLast.PaUid (loc, "()") : 'ipatt));
+        (fun _ _ (loc : Lexing.position * Lexing.position) ->
+           (MLast.PaUid (loc, "()") : 'ipatt));
       [Gramext.Stoken ("", "{");
        Gramext.Slist1sep
          (Gramext.Snterm
@@ -1453,7 +1612,8 @@ Grammar.extend
           Gramext.Stoken ("", ";"));
        Gramext.Stoken ("", "}")],
       Gramext.action
-        (fun _ (lpl : 'label_ipatt list) _ (loc : int * int) ->
+        (fun _ (lpl : 'label_ipatt list) _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.PaRec (loc, lpl) : 'ipatt))]];
     Grammar.Entry.obj (label_ipatt : 'label_ipatt Grammar.Entry.e), None,
     [None, None,
@@ -1463,7 +1623,8 @@ Grammar.extend
        Gramext.Stoken ("", "=");
        Gramext.Snterm (Grammar.Entry.obj (ipatt : 'ipatt Grammar.Entry.e))],
       Gramext.action
-        (fun (p : 'ipatt) _ (i : 'patt_label_ident) (loc : int * int) ->
+        (fun (p : 'ipatt) _ (i : 'patt_label_ident)
+           (loc : Lexing.position * Lexing.position) ->
            (i, p : 'label_ipatt))]];
     Grammar.Entry.obj (type_declaration : 'type_declaration Grammar.Entry.e),
     None,
@@ -1481,13 +1642,15 @@ Grammar.extend
             (Grammar.Entry.obj (constrain : 'constrain Grammar.Entry.e)))],
       Gramext.action
         (fun (cl : 'constrain list) (tk : 'ctyp) _
-           (tpl : 'type_parameter list) (n : 'type_patt) (loc : int * int) ->
+           (tpl : 'type_parameter list) (n : 'type_patt)
+           (loc : Lexing.position * Lexing.position) ->
            (n, tpl, tk, cl : 'type_declaration))]];
     Grammar.Entry.obj (type_patt : 'type_patt Grammar.Entry.e), None,
     [None, None,
      [[Gramext.Stoken ("LIDENT", "")],
       Gramext.action
-        (fun (n : string) (loc : int * int) -> (loc, n : 'type_patt))]];
+        (fun (n : string) (loc : Lexing.position * Lexing.position) ->
+           (loc, n : 'type_patt))]];
     Grammar.Entry.obj (constrain : 'constrain Grammar.Entry.e), None,
     [None, None,
      [[Gramext.Stoken ("", "constraint");
@@ -1495,7 +1658,8 @@ Grammar.extend
        Gramext.Stoken ("", "=");
        Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))],
       Gramext.action
-        (fun (t2 : 'ctyp) _ (t1 : 'ctyp) _ (loc : int * int) ->
+        (fun (t2 : 'ctyp) _ (t1 : 'ctyp) _
+           (loc : Lexing.position * Lexing.position) ->
            (t1, t2 : 'constrain))]];
     Grammar.Entry.obj (type_parameter : 'type_parameter Grammar.Entry.e),
     None,
@@ -1503,28 +1667,30 @@ Grammar.extend
      [[Gramext.Stoken ("", "-"); Gramext.Stoken ("", "'");
        Gramext.Snterm (Grammar.Entry.obj (ident : 'ident Grammar.Entry.e))],
       Gramext.action
-        (fun (i : 'ident) _ _ (loc : int * int) ->
+        (fun (i : 'ident) _ _ (loc : Lexing.position * Lexing.position) ->
            (i, (false, true) : 'type_parameter));
       [Gramext.Stoken ("", "+"); Gramext.Stoken ("", "'");
        Gramext.Snterm (Grammar.Entry.obj (ident : 'ident Grammar.Entry.e))],
       Gramext.action
-        (fun (i : 'ident) _ _ (loc : int * int) ->
+        (fun (i : 'ident) _ _ (loc : Lexing.position * Lexing.position) ->
            (i, (true, false) : 'type_parameter));
       [Gramext.Stoken ("", "'");
        Gramext.Snterm (Grammar.Entry.obj (ident : 'ident Grammar.Entry.e))],
       Gramext.action
-        (fun (i : 'ident) _ (loc : int * int) ->
+        (fun (i : 'ident) _ (loc : Lexing.position * Lexing.position) ->
            (i, (false, false) : 'type_parameter))]];
     Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e), None,
     [None, Some Gramext.LeftA,
      [[Gramext.Sself; Gramext.Stoken ("", "=="); Gramext.Sself],
       Gramext.action
-        (fun (t2 : 'ctyp) _ (t1 : 'ctyp) (loc : int * int) ->
+        (fun (t2 : 'ctyp) _ (t1 : 'ctyp)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.TyMan (loc, t1, t2) : 'ctyp))];
      None, Some Gramext.LeftA,
      [[Gramext.Sself; Gramext.Stoken ("", "as"); Gramext.Sself],
       Gramext.action
-        (fun (t2 : 'ctyp) _ (t1 : 'ctyp) (loc : int * int) ->
+        (fun (t2 : 'ctyp) _ (t1 : 'ctyp)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.TyAli (loc, t1, t2) : 'ctyp))];
      None, Some Gramext.LeftA,
      [[Gramext.Stoken ("", "!");
@@ -1533,41 +1699,49 @@ Grammar.extend
             (Grammar.Entry.obj (typevar : 'typevar Grammar.Entry.e)));
        Gramext.Stoken ("", "."); Gramext.Sself],
       Gramext.action
-        (fun (t : 'ctyp) _ (pl : 'typevar list) _ (loc : int * int) ->
+        (fun (t : 'ctyp) _ (pl : 'typevar list) _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.TyPol (loc, pl, t) : 'ctyp))];
      Some "arrow", Some Gramext.RightA,
      [[Gramext.Sself; Gramext.Stoken ("", "->"); Gramext.Sself],
       Gramext.action
-        (fun (t2 : 'ctyp) _ (t1 : 'ctyp) (loc : int * int) ->
+        (fun (t2 : 'ctyp) _ (t1 : 'ctyp)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.TyArr (loc, t1, t2) : 'ctyp))];
      Some "label", Some Gramext.NonA,
      [[Gramext.Stoken ("OPTLABEL", ""); Gramext.Sself],
       Gramext.action
-        (fun (t : 'ctyp) (i : string) (loc : int * int) ->
+        (fun (t : 'ctyp) (i : string)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.TyOlb (loc, i, t) : 'ctyp));
       [Gramext.Stoken ("QUESTIONIDENT", ""); Gramext.Stoken ("", ":");
        Gramext.Sself],
       Gramext.action
-        (fun (t : 'ctyp) _ (i : string) (loc : int * int) ->
+        (fun (t : 'ctyp) _ (i : string)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.TyOlb (loc, i, t) : 'ctyp));
       [Gramext.Stoken ("LABEL", ""); Gramext.Sself],
       Gramext.action
-        (fun (t : 'ctyp) (i : string) (loc : int * int) ->
+        (fun (t : 'ctyp) (i : string)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.TyLab (loc, i, t) : 'ctyp));
       [Gramext.Stoken ("TILDEIDENT", ""); Gramext.Stoken ("", ":");
        Gramext.Sself],
       Gramext.action
-        (fun (t : 'ctyp) _ (i : string) (loc : int * int) ->
+        (fun (t : 'ctyp) _ (i : string)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.TyLab (loc, i, t) : 'ctyp))];
      None, Some Gramext.LeftA,
      [[Gramext.Sself; Gramext.Sself],
       Gramext.action
-        (fun (t2 : 'ctyp) (t1 : 'ctyp) (loc : int * int) ->
+        (fun (t2 : 'ctyp) (t1 : 'ctyp)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.TyApp (loc, t1, t2) : 'ctyp))];
      None, Some Gramext.LeftA,
      [[Gramext.Sself; Gramext.Stoken ("", "."); Gramext.Sself],
       Gramext.action
-        (fun (t2 : 'ctyp) _ (t1 : 'ctyp) (loc : int * int) ->
+        (fun (t2 : 'ctyp) _ (t1 : 'ctyp)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.TyAcc (loc, t1, t2) : 'ctyp))];
      Some "simple", None,
      [[Gramext.Stoken ("", "{");
@@ -1578,7 +1752,8 @@ Grammar.extend
           Gramext.Stoken ("", ";"));
        Gramext.Stoken ("", "}")],
       Gramext.action
-        (fun _ (ldl : 'label_declaration list) _ (loc : int * int) ->
+        (fun _ (ldl : 'label_declaration list) _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.TyRec (loc, false, ldl) : 'ctyp));
       [Gramext.Stoken ("", "[");
        Gramext.Slist0sep
@@ -1589,7 +1764,8 @@ Grammar.extend
           Gramext.Stoken ("", "|"));
        Gramext.Stoken ("", "]")],
       Gramext.action
-        (fun _ (cdl : 'constructor_declaration list) _ (loc : int * int) ->
+        (fun _ (cdl : 'constructor_declaration list) _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.TySum (loc, false, cdl) : 'ctyp));
       [Gramext.Stoken ("", "private"); Gramext.Stoken ("", "{");
        Gramext.Slist1sep
@@ -1599,7 +1775,8 @@ Grammar.extend
           Gramext.Stoken ("", ";"));
        Gramext.Stoken ("", "}")],
       Gramext.action
-        (fun _ (ldl : 'label_declaration list) _ _ (loc : int * int) ->
+        (fun _ (ldl : 'label_declaration list) _ _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.TyRec (loc, true, ldl) : 'ctyp));
       [Gramext.Stoken ("", "private"); Gramext.Stoken ("", "[");
        Gramext.Slist0sep
@@ -1610,32 +1787,38 @@ Grammar.extend
           Gramext.Stoken ("", "|"));
        Gramext.Stoken ("", "]")],
       Gramext.action
-        (fun _ (cdl : 'constructor_declaration list) _ _ (loc : int * int) ->
+        (fun _ (cdl : 'constructor_declaration list) _ _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.TySum (loc, true, cdl) : 'ctyp));
       [Gramext.Stoken ("", "("); Gramext.Sself; Gramext.Stoken ("", ")")],
-      Gramext.action (fun _ (t : 'ctyp) _ (loc : int * int) -> (t : 'ctyp));
+      Gramext.action
+        (fun _ (t : 'ctyp) _ (loc : Lexing.position * Lexing.position) ->
+           (t : 'ctyp));
       [Gramext.Stoken ("", "("); Gramext.Sself; Gramext.Stoken ("", "*");
        Gramext.Slist1sep
          (Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e)),
           Gramext.Stoken ("", "*"));
        Gramext.Stoken ("", ")")],
       Gramext.action
-        (fun _ (tl : 'ctyp list) _ (t : 'ctyp) _ (loc : int * int) ->
+        (fun _ (tl : 'ctyp list) _ (t : 'ctyp) _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.TyTup (loc, (t :: tl)) : 'ctyp));
       [Gramext.Stoken ("UIDENT", "")],
       Gramext.action
-        (fun (i : string) (loc : int * int) ->
+        (fun (i : string) (loc : Lexing.position * Lexing.position) ->
            (MLast.TyUid (loc, i) : 'ctyp));
       [Gramext.Stoken ("LIDENT", "")],
       Gramext.action
-        (fun (i : string) (loc : int * int) ->
+        (fun (i : string) (loc : Lexing.position * Lexing.position) ->
            (MLast.TyLid (loc, i) : 'ctyp));
       [Gramext.Stoken ("", "_")],
-      Gramext.action (fun _ (loc : int * int) -> (MLast.TyAny loc : 'ctyp));
+      Gramext.action
+        (fun _ (loc : Lexing.position * Lexing.position) ->
+           (MLast.TyAny loc : 'ctyp));
       [Gramext.Stoken ("", "'");
        Gramext.Snterm (Grammar.Entry.obj (ident : 'ident Grammar.Entry.e))],
       Gramext.action
-        (fun (i : 'ident) _ (loc : int * int) ->
+        (fun (i : 'ident) _ (loc : Lexing.position * Lexing.position) ->
            (MLast.TyQuo (loc, i) : 'ctyp))]];
     Grammar.Entry.obj
       (constructor_declaration : 'constructor_declaration Grammar.Entry.e),
@@ -1643,14 +1826,15 @@ Grammar.extend
     [None, None,
      [[Gramext.Stoken ("UIDENT", "")],
       Gramext.action
-        (fun (ci : string) (loc : int * int) ->
+        (fun (ci : string) (loc : Lexing.position * Lexing.position) ->
            (loc, ci, [] : 'constructor_declaration));
       [Gramext.Stoken ("UIDENT", ""); Gramext.Stoken ("", "of");
        Gramext.Slist1sep
          (Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e)),
           Gramext.Stoken ("", "and"))],
       Gramext.action
-        (fun (cal : 'ctyp list) _ (ci : string) (loc : int * int) ->
+        (fun (cal : 'ctyp list) _ (ci : string)
+           (loc : Lexing.position * Lexing.position) ->
            (loc, ci, cal : 'constructor_declaration))]];
     Grammar.Entry.obj
       (label_declaration : 'label_declaration Grammar.Entry.e),
@@ -1661,27 +1845,34 @@ Grammar.extend
        Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))],
       Gramext.action
         (fun (t : 'ctyp) (mf : string option) _ (i : string)
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (loc, i, o2b mf, t : 'label_declaration))]];
     Grammar.Entry.obj (ident : 'ident Grammar.Entry.e), None,
     [None, None,
      [[Gramext.Stoken ("UIDENT", "")],
-      Gramext.action (fun (i : string) (loc : int * int) -> (i : 'ident));
+      Gramext.action
+        (fun (i : string) (loc : Lexing.position * Lexing.position) ->
+           (i : 'ident));
       [Gramext.Stoken ("LIDENT", "")],
-      Gramext.action (fun (i : string) (loc : int * int) -> (i : 'ident))]];
+      Gramext.action
+        (fun (i : string) (loc : Lexing.position * Lexing.position) ->
+           (i : 'ident))]];
     Grammar.Entry.obj (mod_ident : 'mod_ident Grammar.Entry.e), None,
     [None, Some Gramext.RightA,
      [[Gramext.Stoken ("UIDENT", ""); Gramext.Stoken ("", ".");
        Gramext.Sself],
       Gramext.action
-        (fun (j : 'mod_ident) _ (i : string) (loc : int * int) ->
+        (fun (j : 'mod_ident) _ (i : string)
+           (loc : Lexing.position * Lexing.position) ->
            (i :: j : 'mod_ident));
       [Gramext.Stoken ("LIDENT", "")],
       Gramext.action
-        (fun (i : string) (loc : int * int) -> ([i] : 'mod_ident));
+        (fun (i : string) (loc : Lexing.position * Lexing.position) ->
+           ([i] : 'mod_ident));
       [Gramext.Stoken ("UIDENT", "")],
       Gramext.action
-        (fun (i : string) (loc : int * int) -> ([i] : 'mod_ident))]];
+        (fun (i : string) (loc : Lexing.position * Lexing.position) ->
+           ([i] : 'mod_ident))]];
     Grammar.Entry.obj (str_item : 'str_item Grammar.Entry.e), None,
     [None, None,
      [[Gramext.Stoken ("", "class"); Gramext.Stoken ("", "type");
@@ -1692,7 +1883,8 @@ Grammar.extend
                 'class_type_declaration Grammar.Entry.e)),
           Gramext.Stoken ("", "and"))],
       Gramext.action
-        (fun (ctd : 'class_type_declaration list) _ _ (loc : int * int) ->
+        (fun (ctd : 'class_type_declaration list) _ _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.StClt (loc, ctd) : 'str_item));
       [Gramext.Stoken ("", "class");
        Gramext.Slist1sep
@@ -1701,7 +1893,8 @@ Grammar.extend
                (class_declaration : 'class_declaration Grammar.Entry.e)),
           Gramext.Stoken ("", "and"))],
       Gramext.action
-        (fun (cd : 'class_declaration list) _ (loc : int * int) ->
+        (fun (cd : 'class_declaration list) _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.StCls (loc, cd) : 'str_item))]];
     Grammar.Entry.obj (sig_item : 'sig_item Grammar.Entry.e), None,
     [None, None,
@@ -1713,7 +1906,8 @@ Grammar.extend
                 'class_type_declaration Grammar.Entry.e)),
           Gramext.Stoken ("", "and"))],
       Gramext.action
-        (fun (ctd : 'class_type_declaration list) _ _ (loc : int * int) ->
+        (fun (ctd : 'class_type_declaration list) _ _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.SgClt (loc, ctd) : 'sig_item));
       [Gramext.Stoken ("", "class");
        Gramext.Slist1sep
@@ -1722,7 +1916,8 @@ Grammar.extend
                (class_description : 'class_description Grammar.Entry.e)),
           Gramext.Stoken ("", "and"))],
       Gramext.action
-        (fun (cd : 'class_description list) _ (loc : int * int) ->
+        (fun (cd : 'class_description list) _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.SgCls (loc, cd) : 'sig_item))]];
     Grammar.Entry.obj
       (class_declaration : 'class_declaration Grammar.Entry.e),
@@ -1738,7 +1933,8 @@ Grammar.extend
             (class_fun_binding : 'class_fun_binding Grammar.Entry.e))],
       Gramext.action
         (fun (cfb : 'class_fun_binding) (ctp : 'class_type_parameters)
-           (i : string) (vf : string option) (loc : int * int) ->
+           (i : string) (vf : string option)
+           (loc : Lexing.position * Lexing.position) ->
            ({MLast.ciLoc = loc; MLast.ciVir = o2b vf; MLast.ciPrm = ctp;
              MLast.ciNam = i; MLast.ciExp = cfb} :
             'class_declaration))]];
@@ -1749,7 +1945,8 @@ Grammar.extend
      [[Gramext.Snterm (Grammar.Entry.obj (ipatt : 'ipatt Grammar.Entry.e));
        Gramext.Sself],
       Gramext.action
-        (fun (cfb : 'class_fun_binding) (p : 'ipatt) (loc : int * int) ->
+        (fun (cfb : 'class_fun_binding) (p : 'ipatt)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.CeFun (loc, p, cfb) : 'class_fun_binding));
       [Gramext.Stoken ("", ":");
        Gramext.Snterm
@@ -1758,13 +1955,14 @@ Grammar.extend
        Gramext.Snterm
          (Grammar.Entry.obj (class_expr : 'class_expr Grammar.Entry.e))],
       Gramext.action
-        (fun (ce : 'class_expr) _ (ct : 'class_type) _ (loc : int * int) ->
+        (fun (ce : 'class_expr) _ (ct : 'class_type) _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.CeTyc (loc, ce, ct) : 'class_fun_binding));
       [Gramext.Stoken ("", "=");
        Gramext.Snterm
          (Grammar.Entry.obj (class_expr : 'class_expr Grammar.Entry.e))],
       Gramext.action
-        (fun (ce : 'class_expr) _ (loc : int * int) ->
+        (fun (ce : 'class_expr) _ (loc : Lexing.position * Lexing.position) ->
            (ce : 'class_fun_binding))]];
     Grammar.Entry.obj
       (class_type_parameters : 'class_type_parameters Grammar.Entry.e),
@@ -1778,22 +1976,26 @@ Grammar.extend
           Gramext.Stoken ("", ","));
        Gramext.Stoken ("", "]")],
       Gramext.action
-        (fun _ (tpl : 'type_parameter list) _ (loc : int * int) ->
+        (fun _ (tpl : 'type_parameter list) _
+           (loc : Lexing.position * Lexing.position) ->
            (loc, tpl : 'class_type_parameters));
       [],
       Gramext.action
-        (fun (loc : int * int) -> (loc, [] : 'class_type_parameters))]];
+        (fun (loc : Lexing.position * Lexing.position) ->
+           (loc, [] : 'class_type_parameters))]];
     Grammar.Entry.obj (class_fun_def : 'class_fun_def Grammar.Entry.e), None,
     [None, None,
      [[Gramext.Stoken ("", "->");
        Gramext.Snterm
          (Grammar.Entry.obj (class_expr : 'class_expr Grammar.Entry.e))],
       Gramext.action
-        (fun (ce : 'class_expr) _ (loc : int * int) -> (ce : 'class_fun_def));
+        (fun (ce : 'class_expr) _ (loc : Lexing.position * Lexing.position) ->
+           (ce : 'class_fun_def));
       [Gramext.Snterm (Grammar.Entry.obj (ipatt : 'ipatt Grammar.Entry.e));
        Gramext.Sself],
       Gramext.action
-        (fun (ce : 'class_fun_def) (p : 'ipatt) (loc : int * int) ->
+        (fun (ce : 'class_fun_def) (p : 'ipatt)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.CeFun (loc, p, ce) : 'class_fun_def))]];
     Grammar.Entry.obj (class_expr : 'class_expr Grammar.Entry.e), None,
     [Some "top", None,
@@ -1805,7 +2007,7 @@ Grammar.extend
        Gramext.Stoken ("", "in"); Gramext.Sself],
       Gramext.action
         (fun (ce : 'class_expr) _ (lb : 'let_binding list)
-           (rf : string option) _ (loc : int * int) ->
+           (rf : string option) _ (loc : Lexing.position * Lexing.position) ->
            (MLast.CeLet (loc, o2b rf, lb, ce) : 'class_expr));
       [Gramext.Stoken ("", "fun");
        Gramext.Snterm (Grammar.Entry.obj (ipatt : 'ipatt Grammar.Entry.e));
@@ -1813,25 +2015,30 @@ Grammar.extend
          (Grammar.Entry.obj
             (class_fun_def : 'class_fun_def Grammar.Entry.e))],
       Gramext.action
-        (fun (ce : 'class_fun_def) (p : 'ipatt) _ (loc : int * int) ->
+        (fun (ce : 'class_fun_def) (p : 'ipatt) _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.CeFun (loc, p, ce) : 'class_expr))];
      Some "apply", Some Gramext.NonA,
      [[Gramext.Sself;
        Gramext.Snterml
          (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e), "label")],
       Gramext.action
-        (fun (e : 'expr) (ce : 'class_expr) (loc : int * int) ->
+        (fun (e : 'expr) (ce : 'class_expr)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.CeApp (loc, ce, e) : 'class_expr))];
      Some "simple", None,
      [[Gramext.Stoken ("", "("); Gramext.Sself; Gramext.Stoken ("", ")")],
       Gramext.action
-        (fun _ (ce : 'class_expr) _ (loc : int * int) -> (ce : 'class_expr));
+        (fun _ (ce : 'class_expr) _
+           (loc : Lexing.position * Lexing.position) ->
+           (ce : 'class_expr));
       [Gramext.Stoken ("", "("); Gramext.Sself; Gramext.Stoken ("", ":");
        Gramext.Snterm
          (Grammar.Entry.obj (class_type : 'class_type Grammar.Entry.e));
        Gramext.Stoken ("", ")")],
       Gramext.action
-        (fun _ (ct : 'class_type) _ (ce : 'class_expr) _ (loc : int * int) ->
+        (fun _ (ct : 'class_type) _ (ce : 'class_expr) _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.CeTyc (loc, ce, ct) : 'class_expr));
       [Gramext.Stoken ("", "object");
        Gramext.Sopt
@@ -1844,13 +2051,14 @@ Grammar.extend
        Gramext.Stoken ("", "end")],
       Gramext.action
         (fun _ (cf : 'class_structure) (cspo : 'class_self_patt option) _
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.CeStr (loc, cspo, cf) : 'class_expr));
       [Gramext.Snterm
          (Grammar.Entry.obj
             (class_longident : 'class_longident Grammar.Entry.e))],
       Gramext.action
-        (fun (ci : 'class_longident) (loc : int * int) ->
+        (fun (ci : 'class_longident)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.CeCon (loc, ci, []) : 'class_expr));
       [Gramext.Snterm
          (Grammar.Entry.obj
@@ -1862,7 +2070,7 @@ Grammar.extend
        Gramext.Stoken ("", "]")],
       Gramext.action
         (fun _ (ctcl : 'ctyp list) _ (ci : 'class_longident)
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.CeCon (loc, ci, ctcl) : 'class_expr))]];
     Grammar.Entry.obj (class_structure : 'class_structure Grammar.Entry.e),
     None,
@@ -1874,10 +2082,11 @@ Grammar.extend
                    (class_str_item : 'class_str_item Grammar.Entry.e));
               Gramext.Stoken ("", ";")],
              Gramext.action
-               (fun _ (cf : 'class_str_item) (loc : int * int) ->
+               (fun _ (cf : 'class_str_item)
+                  (loc : Lexing.position * Lexing.position) ->
                   (cf : 'e__6))])],
       Gramext.action
-        (fun (cf : 'e__6 list) (loc : int * int) ->
+        (fun (cf : 'e__6 list) (loc : Lexing.position * Lexing.position) ->
            (cf : 'class_structure))]];
     Grammar.Entry.obj (class_self_patt : 'class_self_patt Grammar.Entry.e),
     None,
@@ -1888,27 +2097,30 @@ Grammar.extend
        Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e));
        Gramext.Stoken ("", ")")],
       Gramext.action
-        (fun _ (t : 'ctyp) _ (p : 'patt) _ (loc : int * int) ->
+        (fun _ (t : 'ctyp) _ (p : 'patt) _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.PaTyc (loc, p, t) : 'class_self_patt));
       [Gramext.Stoken ("", "(");
        Gramext.Snterm (Grammar.Entry.obj (patt : 'patt Grammar.Entry.e));
        Gramext.Stoken ("", ")")],
       Gramext.action
-        (fun _ (p : 'patt) _ (loc : int * int) -> (p : 'class_self_patt))]];
+        (fun _ (p : 'patt) _ (loc : Lexing.position * Lexing.position) ->
+           (p : 'class_self_patt))]];
     Grammar.Entry.obj (class_str_item : 'class_str_item Grammar.Entry.e),
     None,
     [None, None,
      [[Gramext.Stoken ("", "initializer");
        Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))],
       Gramext.action
-        (fun (se : 'expr) _ (loc : int * int) ->
+        (fun (se : 'expr) _ (loc : Lexing.position * Lexing.position) ->
            (MLast.CrIni (loc, se) : 'class_str_item));
       [Gramext.Stoken ("", "type");
        Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e));
        Gramext.Stoken ("", "=");
        Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))],
       Gramext.action
-        (fun (t2 : 'ctyp) _ (t1 : 'ctyp) _ (loc : int * int) ->
+        (fun (t2 : 'ctyp) _ (t1 : 'ctyp) _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.CrCtr (loc, t1, t2) : 'class_str_item));
       [Gramext.Stoken ("", "method");
        Gramext.Sopt (Gramext.Stoken ("", "private"));
@@ -1920,7 +2132,7 @@ Grammar.extend
          (Grammar.Entry.obj (fun_binding : 'fun_binding Grammar.Entry.e))],
       Gramext.action
         (fun (e : 'fun_binding) (topt : 'polyt option) (l : 'label)
-           (pf : string option) _ (loc : int * int) ->
+           (pf : string option) _ (loc : Lexing.position * Lexing.position) ->
            (MLast.CrMth (loc, l, o2b pf, e, topt) : 'class_str_item));
       [Gramext.Stoken ("", "method"); Gramext.Stoken ("", "virtual");
        Gramext.Sopt (Gramext.Stoken ("", "private"));
@@ -1929,7 +2141,7 @@ Grammar.extend
        Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))],
       Gramext.action
         (fun (t : 'ctyp) _ (l : 'label) (pf : string option) _ _
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.CrVir (loc, l, o2b pf, t) : 'class_str_item));
       [Gramext.Stoken ("", "value");
        Gramext.Sopt (Gramext.Stoken ("", "mutable"));
@@ -1939,7 +2151,7 @@ Grammar.extend
             (cvalue_binding : 'cvalue_binding Grammar.Entry.e))],
       Gramext.action
         (fun (e : 'cvalue_binding) (lab : 'label) (mf : string option) _
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.CrVal (loc, lab, o2b mf, e) : 'class_str_item));
       [Gramext.Stoken ("", "inherit");
        Gramext.Snterm
@@ -1949,7 +2161,7 @@ Grammar.extend
             (Grammar.Entry.obj (as_lident : 'as_lident Grammar.Entry.e)))],
       Gramext.action
         (fun (pb : 'as_lident option) (ce : 'class_expr) _
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.CrInh (loc, ce, pb) : 'class_str_item));
       [Gramext.Stoken ("", "declare");
        Gramext.Slist0
@@ -1959,22 +2171,27 @@ Grammar.extend
                    (class_str_item : 'class_str_item Grammar.Entry.e));
               Gramext.Stoken ("", ";")],
              Gramext.action
-               (fun _ (s : 'class_str_item) (loc : int * int) ->
+               (fun _ (s : 'class_str_item)
+                  (loc : Lexing.position * Lexing.position) ->
                   (s : 'e__7))]);
        Gramext.Stoken ("", "end")],
       Gramext.action
-        (fun _ (st : 'e__7 list) _ (loc : int * int) ->
+        (fun _ (st : 'e__7 list) _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.CrDcl (loc, st) : 'class_str_item))]];
     Grammar.Entry.obj (as_lident : 'as_lident Grammar.Entry.e), None,
     [None, None,
      [[Gramext.Stoken ("", "as"); Gramext.Stoken ("LIDENT", "")],
       Gramext.action
-        (fun (i : string) _ (loc : int * int) -> (i : 'as_lident))]];
+        (fun (i : string) _ (loc : Lexing.position * Lexing.position) ->
+           (i : 'as_lident))]];
     Grammar.Entry.obj (polyt : 'polyt Grammar.Entry.e), None,
     [None, None,
      [[Gramext.Stoken ("", ":");
        Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))],
-      Gramext.action (fun (t : 'ctyp) _ (loc : int * int) -> (t : 'polyt))]];
+      Gramext.action
+        (fun (t : 'ctyp) _ (loc : Lexing.position * Lexing.position) ->
+           (t : 'polyt))]];
     Grammar.Entry.obj (cvalue_binding : 'cvalue_binding Grammar.Entry.e),
     None,
     [None, None,
@@ -1983,7 +2200,8 @@ Grammar.extend
        Gramext.Stoken ("", "=");
        Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))],
       Gramext.action
-        (fun (e : 'expr) _ (t : 'ctyp) _ (loc : int * int) ->
+        (fun (e : 'expr) _ (t : 'ctyp) _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExCoe (loc, e, None, t) : 'cvalue_binding));
       [Gramext.Stoken ("", ":");
        Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e));
@@ -1992,23 +2210,28 @@ Grammar.extend
        Gramext.Stoken ("", "=");
        Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))],
       Gramext.action
-        (fun (e : 'expr) _ (t2 : 'ctyp) _ (t : 'ctyp) _ (loc : int * int) ->
+        (fun (e : 'expr) _ (t2 : 'ctyp) _ (t : 'ctyp) _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExCoe (loc, e, Some t, t2) : 'cvalue_binding));
       [Gramext.Stoken ("", ":");
        Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e));
        Gramext.Stoken ("", "=");
        Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))],
       Gramext.action
-        (fun (e : 'expr) _ (t : 'ctyp) _ (loc : int * int) ->
+        (fun (e : 'expr) _ (t : 'ctyp) _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExTyc (loc, e, t) : 'cvalue_binding));
       [Gramext.Stoken ("", "=");
        Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))],
       Gramext.action
-        (fun (e : 'expr) _ (loc : int * int) -> (e : 'cvalue_binding))]];
+        (fun (e : 'expr) _ (loc : Lexing.position * Lexing.position) ->
+           (e : 'cvalue_binding))]];
     Grammar.Entry.obj (label : 'label Grammar.Entry.e), None,
     [None, None,
      [[Gramext.Stoken ("LIDENT", "")],
-      Gramext.action (fun (i : string) (loc : int * int) -> (i : 'label))]];
+      Gramext.action
+        (fun (i : string) (loc : Lexing.position * Lexing.position) ->
+           (i : 'label))]];
     Grammar.Entry.obj (class_type : 'class_type Grammar.Entry.e), None,
     [None, None,
      [[Gramext.Stoken ("", "object");
@@ -2023,18 +2246,20 @@ Grammar.extend
                    (class_sig_item : 'class_sig_item Grammar.Entry.e));
               Gramext.Stoken ("", ";")],
              Gramext.action
-               (fun _ (csf : 'class_sig_item) (loc : int * int) ->
+               (fun _ (csf : 'class_sig_item)
+                  (loc : Lexing.position * Lexing.position) ->
                   (csf : 'e__8))]);
        Gramext.Stoken ("", "end")],
       Gramext.action
         (fun _ (csf : 'e__8 list) (cst : 'class_self_type option) _
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.CtSig (loc, cst, csf) : 'class_type));
       [Gramext.Snterm
          (Grammar.Entry.obj
             (clty_longident : 'clty_longident Grammar.Entry.e))],
       Gramext.action
-        (fun (id : 'clty_longident) (loc : int * int) ->
+        (fun (id : 'clty_longident)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.CtCon (loc, id, []) : 'class_type));
       [Gramext.Snterm
          (Grammar.Entry.obj
@@ -2045,13 +2270,15 @@ Grammar.extend
           Gramext.Stoken ("", ","));
        Gramext.Stoken ("", "]")],
       Gramext.action
-        (fun _ (tl : 'ctyp list) _ (id : 'clty_longident) (loc : int * int) ->
+        (fun _ (tl : 'ctyp list) _ (id : 'clty_longident)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.CtCon (loc, id, tl) : 'class_type));
       [Gramext.Stoken ("", "[");
        Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e));
        Gramext.Stoken ("", "]"); Gramext.Stoken ("", "->"); Gramext.Sself],
       Gramext.action
-        (fun (ct : 'class_type) _ _ (t : 'ctyp) _ (loc : int * int) ->
+        (fun (ct : 'class_type) _ _ (t : 'ctyp) _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.CtFun (loc, t, ct) : 'class_type))]];
     Grammar.Entry.obj (class_self_type : 'class_self_type Grammar.Entry.e),
     None,
@@ -2060,7 +2287,8 @@ Grammar.extend
        Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e));
        Gramext.Stoken ("", ")")],
       Gramext.action
-        (fun _ (t : 'ctyp) _ (loc : int * int) -> (t : 'class_self_type))]];
+        (fun _ (t : 'ctyp) _ (loc : Lexing.position * Lexing.position) ->
+           (t : 'class_self_type))]];
     Grammar.Entry.obj (class_sig_item : 'class_sig_item Grammar.Entry.e),
     None,
     [None, None,
@@ -2069,7 +2297,8 @@ Grammar.extend
        Gramext.Stoken ("", "=");
        Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))],
       Gramext.action
-        (fun (t2 : 'ctyp) _ (t1 : 'ctyp) _ (loc : int * int) ->
+        (fun (t2 : 'ctyp) _ (t1 : 'ctyp) _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.CgCtr (loc, t1, t2) : 'class_sig_item));
       [Gramext.Stoken ("", "method");
        Gramext.Sopt (Gramext.Stoken ("", "private"));
@@ -2078,7 +2307,7 @@ Grammar.extend
        Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))],
       Gramext.action
         (fun (t : 'ctyp) _ (l : 'label) (pf : string option) _
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.CgMth (loc, l, o2b pf, t) : 'class_sig_item));
       [Gramext.Stoken ("", "method"); Gramext.Stoken ("", "virtual");
        Gramext.Sopt (Gramext.Stoken ("", "private"));
@@ -2087,7 +2316,7 @@ Grammar.extend
        Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))],
       Gramext.action
         (fun (t : 'ctyp) _ (l : 'label) (pf : string option) _ _
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.CgVir (loc, l, o2b pf, t) : 'class_sig_item));
       [Gramext.Stoken ("", "value");
        Gramext.Sopt (Gramext.Stoken ("", "mutable"));
@@ -2096,13 +2325,13 @@ Grammar.extend
        Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))],
       Gramext.action
         (fun (t : 'ctyp) _ (l : 'label) (mf : string option) _
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.CgVal (loc, l, o2b mf, t) : 'class_sig_item));
       [Gramext.Stoken ("", "inherit");
        Gramext.Snterm
          (Grammar.Entry.obj (class_type : 'class_type Grammar.Entry.e))],
       Gramext.action
-        (fun (cs : 'class_type) _ (loc : int * int) ->
+        (fun (cs : 'class_type) _ (loc : Lexing.position * Lexing.position) ->
            (MLast.CgInh (loc, cs) : 'class_sig_item));
       [Gramext.Stoken ("", "declare");
        Gramext.Slist0
@@ -2112,11 +2341,13 @@ Grammar.extend
                    (class_sig_item : 'class_sig_item Grammar.Entry.e));
               Gramext.Stoken ("", ";")],
              Gramext.action
-               (fun _ (s : 'class_sig_item) (loc : int * int) ->
+               (fun _ (s : 'class_sig_item)
+                  (loc : Lexing.position * Lexing.position) ->
                   (s : 'e__9))]);
        Gramext.Stoken ("", "end")],
       Gramext.action
-        (fun _ (st : 'e__9 list) _ (loc : int * int) ->
+        (fun _ (st : 'e__9 list) _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.CgDcl (loc, st) : 'class_sig_item))]];
     Grammar.Entry.obj
       (class_description : 'class_description Grammar.Entry.e),
@@ -2132,7 +2363,7 @@ Grammar.extend
          (Grammar.Entry.obj (class_type : 'class_type Grammar.Entry.e))],
       Gramext.action
         (fun (ct : 'class_type) _ (ctp : 'class_type_parameters) (n : string)
-           (vf : string option) (loc : int * int) ->
+           (vf : string option) (loc : Lexing.position * Lexing.position) ->
            ({MLast.ciLoc = loc; MLast.ciVir = o2b vf; MLast.ciPrm = ctp;
              MLast.ciNam = n; MLast.ciExp = ct} :
             'class_description))]];
@@ -2150,7 +2381,7 @@ Grammar.extend
          (Grammar.Entry.obj (class_type : 'class_type Grammar.Entry.e))],
       Gramext.action
         (fun (cs : 'class_type) _ (ctp : 'class_type_parameters) (n : string)
-           (vf : string option) (loc : int * int) ->
+           (vf : string option) (loc : Lexing.position * Lexing.position) ->
            ({MLast.ciLoc = loc; MLast.ciVir = o2b vf; MLast.ciPrm = ctp;
              MLast.ciNam = n; MLast.ciExp = cs} :
             'class_type_declaration))]];
@@ -2162,7 +2393,8 @@ Grammar.extend
          (Grammar.Entry.obj
             (class_longident : 'class_longident Grammar.Entry.e))],
       Gramext.action
-        (fun (i : 'class_longident) _ (loc : int * int) ->
+        (fun (i : 'class_longident) _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExNew (loc, i) : 'expr))]];
     Grammar.Entry.obj (expr : 'expr Grammar.Entry.e),
     Some (Gramext.Level "."),
@@ -2170,7 +2402,8 @@ Grammar.extend
      [[Gramext.Sself; Gramext.Stoken ("", "#");
        Gramext.Snterm (Grammar.Entry.obj (label : 'label Grammar.Entry.e))],
       Gramext.action
-        (fun (lab : 'label) _ (e : 'expr) (loc : int * int) ->
+        (fun (lab : 'label) _ (e : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExSnd (loc, e, lab) : 'expr))]];
     Grammar.Entry.obj (expr : 'expr Grammar.Entry.e),
     Some (Gramext.Level "simple"),
@@ -2182,13 +2415,15 @@ Grammar.extend
           Gramext.Stoken ("", ";"));
        Gramext.Stoken ("", ">}")],
       Gramext.action
-        (fun _ (fel : 'field_expr list) _ (loc : int * int) ->
+        (fun _ (fel : 'field_expr list) _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExOvr (loc, fel) : 'expr));
       [Gramext.Stoken ("", "("); Gramext.Sself; Gramext.Stoken ("", ":>");
        Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e));
        Gramext.Stoken ("", ")")],
       Gramext.action
-        (fun _ (t : 'ctyp) _ (e : 'expr) _ (loc : int * int) ->
+        (fun _ (t : 'ctyp) _ (e : 'expr) _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExCoe (loc, e, None, t) : 'expr));
       [Gramext.Stoken ("", "("); Gramext.Sself; Gramext.Stoken ("", ":");
        Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e));
@@ -2196,7 +2431,8 @@ Grammar.extend
        Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e));
        Gramext.Stoken ("", ")")],
       Gramext.action
-        (fun _ (t2 : 'ctyp) _ (t : 'ctyp) _ (e : 'expr) _ (loc : int * int) ->
+        (fun _ (t2 : 'ctyp) _ (t : 'ctyp) _ (e : 'expr) _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExCoe (loc, e, Some t, t2) : 'expr))]];
     Grammar.Entry.obj (field_expr : 'field_expr Grammar.Entry.e), None,
     [None, None,
@@ -2204,65 +2440,120 @@ Grammar.extend
        Gramext.Stoken ("", "=");
        Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))],
       Gramext.action
-        (fun (e : 'expr) _ (l : 'label) (loc : int * int) ->
+        (fun (e : 'expr) _ (l : 'label)
+           (loc : Lexing.position * Lexing.position) ->
            (l, e : 'field_expr))]];
     Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e),
     Some (Gramext.Level "simple"),
     [None, None,
-     [[Gramext.Stoken ("", "<");
-       Gramext.Slist0sep
-         (Gramext.Snterm (Grammar.Entry.obj (field : 'field Grammar.Entry.e)),
-          Gramext.Stoken ("", ";"));
-       Gramext.Sopt (Gramext.Stoken ("", "..")); Gramext.Stoken ("", ">")],
+     [[Gramext.Stoken ("", "<"); Gramext.Stoken ("", ">")],
+      Gramext.action
+        (fun _ _ (loc : Lexing.position * Lexing.position) ->
+           (MLast.TyObj (loc, [], false) : 'ctyp));
+      [Gramext.Stoken ("", "<");
+       Gramext.Snterm
+         (Grammar.Entry.obj (meth_list : 'meth_list Grammar.Entry.e));
+       Gramext.Stoken ("", ">")],
       Gramext.action
-        (fun _ (v : string option) (ml : 'field list) _ (loc : int * int) ->
-           (MLast.TyObj (loc, ml, o2b v) : 'ctyp));
+        (fun _ (ml, v : 'meth_list) _
+           (loc : Lexing.position * Lexing.position) ->
+           (MLast.TyObj (loc, ml, v) : 'ctyp));
       [Gramext.Stoken ("", "#");
        Gramext.Snterm
          (Grammar.Entry.obj
             (class_longident : 'class_longident Grammar.Entry.e))],
       Gramext.action
-        (fun (id : 'class_longident) _ (loc : int * int) ->
+        (fun (id : 'class_longident) _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.TyCls (loc, id) : 'ctyp))]];
+    Grammar.Entry.obj (meth_list : 'meth_list Grammar.Entry.e), None,
+    [None, None,
+     [[Gramext.Stoken ("", "..")],
+      Gramext.action
+        (fun _ (loc : Lexing.position * Lexing.position) ->
+           ([], true : 'meth_list));
+      [Gramext.Snterm (Grammar.Entry.obj (field : 'field Grammar.Entry.e))],
+      Gramext.action
+        (fun (f : 'field) (loc : Lexing.position * Lexing.position) ->
+           ([f], false : 'meth_list));
+      [Gramext.Snterm (Grammar.Entry.obj (field : 'field Grammar.Entry.e));
+       Gramext.Stoken ("", ";")],
+      Gramext.action
+        (fun _ (f : 'field) (loc : Lexing.position * Lexing.position) ->
+           ([f], false : 'meth_list));
+      [Gramext.Snterm (Grammar.Entry.obj (field : 'field Grammar.Entry.e));
+       Gramext.Stoken ("", ";"); Gramext.Sself],
+      Gramext.action
+        (fun (ml, v : 'meth_list) _ (f : 'field)
+           (loc : Lexing.position * Lexing.position) ->
+           (f :: ml, v : 'meth_list))]];
     Grammar.Entry.obj (field : 'field Grammar.Entry.e), None,
     [None, None,
      [[Gramext.Stoken ("LIDENT", ""); Gramext.Stoken ("", ":");
        Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))],
       Gramext.action
-        (fun (t : 'ctyp) _ (lab : string) (loc : int * int) ->
+        (fun (t : 'ctyp) _ (lab : string)
+           (loc : Lexing.position * Lexing.position) ->
            (lab, t : 'field))]];
     Grammar.Entry.obj (typevar : 'typevar Grammar.Entry.e), None,
     [None, None,
      [[Gramext.Stoken ("", "'");
        Gramext.Snterm (Grammar.Entry.obj (ident : 'ident Grammar.Entry.e))],
       Gramext.action
-        (fun (i : 'ident) _ (loc : int * int) -> (i : 'typevar))]];
+        (fun (i : 'ident) _ (loc : Lexing.position * Lexing.position) ->
+           (i : 'typevar))]];
     Grammar.Entry.obj (clty_longident : 'clty_longident Grammar.Entry.e),
     None,
     [None, None,
      [[Gramext.Stoken ("LIDENT", "")],
       Gramext.action
-        (fun (i : string) (loc : int * int) -> ([i] : 'clty_longident));
+        (fun (i : string) (loc : Lexing.position * Lexing.position) ->
+           ([i] : 'clty_longident));
       [Gramext.Stoken ("UIDENT", ""); Gramext.Stoken ("", ".");
        Gramext.Sself],
       Gramext.action
-        (fun (l : 'clty_longident) _ (m : string) (loc : int * int) ->
+        (fun (l : 'clty_longident) _ (m : string)
+           (loc : Lexing.position * Lexing.position) ->
            (m :: l : 'clty_longident))]];
     Grammar.Entry.obj (class_longident : 'class_longident Grammar.Entry.e),
     None,
     [None, None,
      [[Gramext.Stoken ("LIDENT", "")],
       Gramext.action
-        (fun (i : string) (loc : int * int) -> ([i] : 'class_longident));
+        (fun (i : string) (loc : Lexing.position * Lexing.position) ->
+           ([i] : 'class_longident));
       [Gramext.Stoken ("UIDENT", ""); Gramext.Stoken ("", ".");
        Gramext.Sself],
       Gramext.action
-        (fun (l : 'class_longident) _ (m : string) (loc : int * int) ->
+        (fun (l : 'class_longident) _ (m : string)
+           (loc : Lexing.position * Lexing.position) ->
            (m :: l : 'class_longident))]];
     Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e),
     Some (Gramext.Level "simple"),
     [None, None,
-     [[Gramext.Stoken ("", "["); Gramext.Stoken ("", "<");
+     [[Gramext.Stoken ("", "[<");
+       Gramext.Snterm
+         (Grammar.Entry.obj
+            (row_field_list : 'row_field_list Grammar.Entry.e));
+       Gramext.Stoken ("", ">");
+       Gramext.Slist1
+         (Gramext.Snterm
+            (Grammar.Entry.obj (name_tag : 'name_tag Grammar.Entry.e)));
+       Gramext.Stoken ("", "]")],
+      Gramext.action
+        (fun _ (ntl : 'name_tag list) _ (rfl : 'row_field_list) _
+           (loc : Lexing.position * Lexing.position) ->
+           (MLast.TyVrn (loc, rfl, Some (Some ntl)) : 'ctyp));
+      [Gramext.Stoken ("", "[<");
+       Gramext.Snterm
+         (Grammar.Entry.obj
+            (row_field_list : 'row_field_list Grammar.Entry.e));
+       Gramext.Stoken ("", "]")],
+      Gramext.action
+        (fun _ (rfl : 'row_field_list) _
+           (loc : Lexing.position * Lexing.position) ->
+           (MLast.TyVrn (loc, rfl, Some (Some [])) : 'ctyp));
+      [Gramext.Stoken ("", "["); Gramext.Stoken ("", "<");
        Gramext.Snterm
          (Grammar.Entry.obj
             (row_field_list : 'row_field_list Grammar.Entry.e));
@@ -2273,7 +2564,7 @@ Grammar.extend
        Gramext.Stoken ("", "]")],
       Gramext.action
         (fun _ (ntl : 'name_tag list) _ (rfl : 'row_field_list) _ _
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.TyVrn (loc, rfl, Some (Some ntl)) : 'ctyp));
       [Gramext.Stoken ("", "["); Gramext.Stoken ("", "<");
        Gramext.Snterm
@@ -2281,7 +2572,8 @@ Grammar.extend
             (row_field_list : 'row_field_list Grammar.Entry.e));
        Gramext.Stoken ("", "]")],
       Gramext.action
-        (fun _ (rfl : 'row_field_list) _ _ (loc : int * int) ->
+        (fun _ (rfl : 'row_field_list) _ _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.TyVrn (loc, rfl, Some (Some [])) : 'ctyp));
       [Gramext.Stoken ("", "["); Gramext.Stoken ("", ">");
        Gramext.Snterm
@@ -2289,7 +2581,8 @@ Grammar.extend
             (row_field_list : 'row_field_list Grammar.Entry.e));
        Gramext.Stoken ("", "]")],
       Gramext.action
-        (fun _ (rfl : 'row_field_list) _ _ (loc : int * int) ->
+        (fun _ (rfl : 'row_field_list) _ _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.TyVrn (loc, rfl, Some None) : 'ctyp));
       [Gramext.Stoken ("", "["); Gramext.Stoken ("", "=");
        Gramext.Snterm
@@ -2297,7 +2590,8 @@ Grammar.extend
             (row_field_list : 'row_field_list Grammar.Entry.e));
        Gramext.Stoken ("", "]")],
       Gramext.action
-        (fun _ (rfl : 'row_field_list) _ _ (loc : int * int) ->
+        (fun _ (rfl : 'row_field_list) _ _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.TyVrn (loc, rfl, None) : 'ctyp))]];
     Grammar.Entry.obj (row_field_list : 'row_field_list Grammar.Entry.e),
     None,
@@ -2307,13 +2601,15 @@ Grammar.extend
             (Grammar.Entry.obj (row_field : 'row_field Grammar.Entry.e)),
           Gramext.Stoken ("", "|"))],
       Gramext.action
-        (fun (rfl : 'row_field list) (loc : int * int) ->
+        (fun (rfl : 'row_field list)
+           (loc : Lexing.position * Lexing.position) ->
            (rfl : 'row_field_list))]];
     Grammar.Entry.obj (row_field : 'row_field Grammar.Entry.e), None,
     [None, None,
      [[Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))],
       Gramext.action
-        (fun (t : 'ctyp) (loc : int * int) -> (MLast.RfInh t : 'row_field));
+        (fun (t : 'ctyp) (loc : Lexing.position * Lexing.position) ->
+           (MLast.RfInh t : 'row_field));
       [Gramext.Stoken ("", "`");
        Gramext.Snterm (Grammar.Entry.obj (ident : 'ident Grammar.Entry.e));
        Gramext.Stoken ("", "of"); Gramext.Sopt (Gramext.Stoken ("", "&"));
@@ -2322,19 +2618,20 @@ Grammar.extend
           Gramext.Stoken ("", "&"))],
       Gramext.action
         (fun (l : 'ctyp list) (ao : string option) _ (i : 'ident) _
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.RfTag (i, o2b ao, l) : 'row_field));
       [Gramext.Stoken ("", "`");
        Gramext.Snterm (Grammar.Entry.obj (ident : 'ident Grammar.Entry.e))],
       Gramext.action
-        (fun (i : 'ident) _ (loc : int * int) ->
+        (fun (i : 'ident) _ (loc : Lexing.position * Lexing.position) ->
            (MLast.RfTag (i, true, []) : 'row_field))]];
     Grammar.Entry.obj (name_tag : 'name_tag Grammar.Entry.e), None,
     [None, None,
      [[Gramext.Stoken ("", "`");
        Gramext.Snterm (Grammar.Entry.obj (ident : 'ident Grammar.Entry.e))],
       Gramext.action
-        (fun (i : 'ident) _ (loc : int * int) -> (i : 'name_tag))]];
+        (fun (i : 'ident) _ (loc : Lexing.position * Lexing.position) ->
+           (i : 'name_tag))]];
     Grammar.Entry.obj (patt : 'patt Grammar.Entry.e),
     Some (Gramext.Level "simple"),
     [None, None,
@@ -2347,11 +2644,11 @@ Grammar.extend
        Gramext.Stoken ("", ")")],
       Gramext.action
         (fun _ (eo : 'eq_expr option) (p : 'patt_tcon) _ _
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.PaOlb (loc, "", Some (p, eo)) : 'patt));
       [Gramext.Stoken ("QUESTIONIDENT", "")],
       Gramext.action
-        (fun (i : string) (loc : int * int) ->
+        (fun (i : string) (loc : Lexing.position * Lexing.position) ->
            (MLast.PaOlb (loc, i, None) : 'patt));
       [Gramext.Stoken ("OPTLABEL", ""); Gramext.Stoken ("", "(");
        Gramext.Snterm
@@ -2362,7 +2659,7 @@ Grammar.extend
        Gramext.Stoken ("", ")")],
       Gramext.action
         (fun _ (eo : 'eq_expr option) (p : 'patt_tcon) _ (i : string)
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.PaOlb (loc, i, Some (p, eo)) : 'patt));
       [Gramext.Stoken ("QUESTIONIDENT", ""); Gramext.Stoken ("", ":");
        Gramext.Stoken ("", "(");
@@ -2374,41 +2671,46 @@ Grammar.extend
        Gramext.Stoken ("", ")")],
       Gramext.action
         (fun _ (eo : 'eq_expr option) (p : 'patt_tcon) _ _ (i : string)
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.PaOlb (loc, i, Some (p, eo)) : 'patt));
       [Gramext.Stoken ("TILDEIDENT", "")],
       Gramext.action
-        (fun (i : string) (loc : int * int) ->
+        (fun (i : string) (loc : Lexing.position * Lexing.position) ->
            (MLast.PaLab (loc, i, None) : 'patt));
       [Gramext.Stoken ("LABEL", ""); Gramext.Sself],
       Gramext.action
-        (fun (p : 'patt) (i : string) (loc : int * int) ->
+        (fun (p : 'patt) (i : string)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.PaLab (loc, i, Some p) : 'patt));
       [Gramext.Stoken ("TILDEIDENT", ""); Gramext.Stoken ("", ":");
        Gramext.Sself],
       Gramext.action
-        (fun (p : 'patt) _ (i : string) (loc : int * int) ->
+        (fun (p : 'patt) _ (i : string)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.PaLab (loc, i, Some p) : 'patt));
       [Gramext.Stoken ("", "#");
        Gramext.Snterm
          (Grammar.Entry.obj (mod_ident : 'mod_ident Grammar.Entry.e))],
       Gramext.action
-        (fun (sl : 'mod_ident) _ (loc : int * int) ->
+        (fun (sl : 'mod_ident) _ (loc : Lexing.position * Lexing.position) ->
            (MLast.PaTyp (loc, sl) : 'patt));
       [Gramext.Stoken ("", "`");
        Gramext.Snterm (Grammar.Entry.obj (ident : 'ident Grammar.Entry.e))],
       Gramext.action
-        (fun (s : 'ident) _ (loc : int * int) ->
+        (fun (s : 'ident) _ (loc : Lexing.position * Lexing.position) ->
            (MLast.PaVrn (loc, s) : 'patt))]];
     Grammar.Entry.obj (patt_tcon : 'patt_tcon Grammar.Entry.e), None,
     [None, None,
      [[Gramext.Snterm (Grammar.Entry.obj (patt : 'patt Grammar.Entry.e))],
-      Gramext.action (fun (p : 'patt) (loc : int * int) -> (p : 'patt_tcon));
+      Gramext.action
+        (fun (p : 'patt) (loc : Lexing.position * Lexing.position) ->
+           (p : 'patt_tcon));
       [Gramext.Snterm (Grammar.Entry.obj (patt : 'patt Grammar.Entry.e));
        Gramext.Stoken ("", ":");
        Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))],
       Gramext.action
-        (fun (t : 'ctyp) _ (p : 'patt) (loc : int * int) ->
+        (fun (t : 'ctyp) _ (p : 'patt)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.PaTyc (loc, p, t) : 'patt_tcon))]];
     Grammar.Entry.obj (ipatt : 'ipatt Grammar.Entry.e), None,
     [None, None,
@@ -2421,11 +2723,11 @@ Grammar.extend
        Gramext.Stoken ("", ")")],
       Gramext.action
         (fun _ (eo : 'eq_expr option) (p : 'ipatt_tcon) _ _
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.PaOlb (loc, "", Some (p, eo)) : 'ipatt));
       [Gramext.Stoken ("QUESTIONIDENT", "")],
       Gramext.action
-        (fun (i : string) (loc : int * int) ->
+        (fun (i : string) (loc : Lexing.position * Lexing.position) ->
            (MLast.PaOlb (loc, i, None) : 'ipatt));
       [Gramext.Stoken ("OPTLABEL", ""); Gramext.Stoken ("", "(");
        Gramext.Snterm
@@ -2436,7 +2738,7 @@ Grammar.extend
        Gramext.Stoken ("", ")")],
       Gramext.action
         (fun _ (eo : 'eq_expr option) (p : 'ipatt_tcon) _ (i : string)
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.PaOlb (loc, i, Some (p, eo)) : 'ipatt));
       [Gramext.Stoken ("QUESTIONIDENT", ""); Gramext.Stoken ("", ":");
        Gramext.Stoken ("", "(");
@@ -2448,66 +2750,75 @@ Grammar.extend
        Gramext.Stoken ("", ")")],
       Gramext.action
         (fun _ (eo : 'eq_expr option) (p : 'ipatt_tcon) _ _ (i : string)
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.PaOlb (loc, i, Some (p, eo)) : 'ipatt));
       [Gramext.Stoken ("TILDEIDENT", "")],
       Gramext.action
-        (fun (i : string) (loc : int * int) ->
+        (fun (i : string) (loc : Lexing.position * Lexing.position) ->
            (MLast.PaLab (loc, i, None) : 'ipatt));
       [Gramext.Stoken ("LABEL", ""); Gramext.Sself],
       Gramext.action
-        (fun (p : 'ipatt) (i : string) (loc : int * int) ->
+        (fun (p : 'ipatt) (i : string)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.PaLab (loc, i, Some p) : 'ipatt));
       [Gramext.Stoken ("TILDEIDENT", ""); Gramext.Stoken ("", ":");
        Gramext.Sself],
       Gramext.action
-        (fun (p : 'ipatt) _ (i : string) (loc : int * int) ->
+        (fun (p : 'ipatt) _ (i : string)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.PaLab (loc, i, Some p) : 'ipatt))]];
     Grammar.Entry.obj (ipatt_tcon : 'ipatt_tcon Grammar.Entry.e), None,
     [None, None,
      [[Gramext.Snterm (Grammar.Entry.obj (ipatt : 'ipatt Grammar.Entry.e))],
       Gramext.action
-        (fun (p : 'ipatt) (loc : int * int) -> (p : 'ipatt_tcon));
+        (fun (p : 'ipatt) (loc : Lexing.position * Lexing.position) ->
+           (p : 'ipatt_tcon));
       [Gramext.Snterm (Grammar.Entry.obj (ipatt : 'ipatt Grammar.Entry.e));
        Gramext.Stoken ("", ":");
        Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))],
       Gramext.action
-        (fun (t : 'ctyp) _ (p : 'ipatt) (loc : int * int) ->
+        (fun (t : 'ctyp) _ (p : 'ipatt)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.PaTyc (loc, p, t) : 'ipatt_tcon))]];
     Grammar.Entry.obj (eq_expr : 'eq_expr Grammar.Entry.e), None,
     [None, None,
      [[Gramext.Stoken ("", "=");
        Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))],
       Gramext.action
-        (fun (e : 'expr) _ (loc : int * int) -> (e : 'eq_expr))]];
+        (fun (e : 'expr) _ (loc : Lexing.position * Lexing.position) ->
+           (e : 'eq_expr))]];
     Grammar.Entry.obj (expr : 'expr Grammar.Entry.e),
     Some (Gramext.After "apply"),
     [Some "label", Some Gramext.NonA,
      [[Gramext.Stoken ("QUESTIONIDENT", "")],
       Gramext.action
-        (fun (i : string) (loc : int * int) ->
+        (fun (i : string) (loc : Lexing.position * Lexing.position) ->
            (MLast.ExOlb (loc, i, None) : 'expr));
       [Gramext.Stoken ("OPTLABEL", ""); Gramext.Sself],
       Gramext.action
-        (fun (e : 'expr) (i : string) (loc : int * int) ->
+        (fun (e : 'expr) (i : string)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExOlb (loc, i, Some e) : 'expr));
       [Gramext.Stoken ("QUESTIONIDENT", ""); Gramext.Stoken ("", ":");
        Gramext.Sself],
       Gramext.action
-        (fun (e : 'expr) _ (i : string) (loc : int * int) ->
+        (fun (e : 'expr) _ (i : string)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExOlb (loc, i, Some e) : 'expr));
       [Gramext.Stoken ("TILDEIDENT", "")],
       Gramext.action
-        (fun (i : string) (loc : int * int) ->
+        (fun (i : string) (loc : Lexing.position * Lexing.position) ->
            (MLast.ExLab (loc, i, None) : 'expr));
       [Gramext.Stoken ("LABEL", ""); Gramext.Sself],
       Gramext.action
-        (fun (e : 'expr) (i : string) (loc : int * int) ->
+        (fun (e : 'expr) (i : string)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExLab (loc, i, Some e) : 'expr));
       [Gramext.Stoken ("TILDEIDENT", ""); Gramext.Stoken ("", ":");
        Gramext.Sself],
       Gramext.action
-        (fun (e : 'expr) _ (i : string) (loc : int * int) ->
+        (fun (e : 'expr) _ (i : string)
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExLab (loc, i, Some e) : 'expr))]];
     Grammar.Entry.obj (expr : 'expr Grammar.Entry.e),
     Some (Gramext.Level "simple"),
@@ -2515,15 +2826,19 @@ Grammar.extend
      [[Gramext.Stoken ("", "`");
        Gramext.Snterm (Grammar.Entry.obj (ident : 'ident Grammar.Entry.e))],
       Gramext.action
-        (fun (s : 'ident) _ (loc : int * int) ->
+        (fun (s : 'ident) _ (loc : Lexing.position * Lexing.position) ->
            (MLast.ExVrn (loc, s) : 'expr))]];
     Grammar.Entry.obj (direction_flag : 'direction_flag Grammar.Entry.e),
     None,
     [None, None,
      [[Gramext.Stoken ("", "downto")],
-      Gramext.action (fun _ (loc : int * int) -> (false : 'direction_flag));
+      Gramext.action
+        (fun _ (loc : Lexing.position * Lexing.position) ->
+           (false : 'direction_flag));
       [Gramext.Stoken ("", "to")],
-      Gramext.action (fun _ (loc : int * int) -> (true : 'direction_flag))]];
+      Gramext.action
+        (fun _ (loc : Lexing.position * Lexing.position) ->
+           (true : 'direction_flag))]];
     Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e),
     Some (Gramext.Level "simple"),
     [None, None,
@@ -2542,7 +2857,7 @@ Grammar.extend
        Gramext.Stoken ("", "|]")],
       Gramext.action
         (fun _ (ntl : 'name_tag list) _ (rfl : 'row_field_list) _ _ _
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.TyVrn (loc, rfl, Some (Some ntl)) : 'ctyp));
       [Gramext.Stoken ("", "[|");
        Gramext.Snterm
@@ -2554,7 +2869,8 @@ Grammar.extend
             (row_field_list : 'row_field_list Grammar.Entry.e));
        Gramext.Stoken ("", "|]")],
       Gramext.action
-        (fun _ (rfl : 'row_field_list) _ _ _ (loc : int * int) ->
+        (fun _ (rfl : 'row_field_list) _ _ _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.TyVrn (loc, rfl, Some (Some [])) : 'ctyp));
       [Gramext.Stoken ("", "[|");
        Gramext.Snterm
@@ -2566,7 +2882,8 @@ Grammar.extend
             (row_field_list : 'row_field_list Grammar.Entry.e));
        Gramext.Stoken ("", "|]")],
       Gramext.action
-        (fun _ (rfl : 'row_field_list) _ _ _ (loc : int * int) ->
+        (fun _ (rfl : 'row_field_list) _ _ _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.TyVrn (loc, rfl, Some None) : 'ctyp));
       [Gramext.Stoken ("", "[|");
        Gramext.Snterm
@@ -2577,14 +2894,16 @@ Grammar.extend
             (row_field_list : 'row_field_list Grammar.Entry.e));
        Gramext.Stoken ("", "|]")],
       Gramext.action
-        (fun _ (rfl : 'row_field_list) _ _ (loc : int * int) ->
+        (fun _ (rfl : 'row_field_list) _ _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.TyVrn (loc, rfl, None) : 'ctyp))]];
     Grammar.Entry.obj (warning_variant : 'warning_variant Grammar.Entry.e),
     None,
     [None, None,
      [[],
       Gramext.action
-        (fun (loc : int * int) -> (warn_variant loc : 'warning_variant))]];
+        (fun (loc : Lexing.position * Lexing.position) ->
+           (warn_variant loc : 'warning_variant))]];
     Grammar.Entry.obj (expr : 'expr Grammar.Entry.e),
     Some (Gramext.Level "top"),
     [None, None,
@@ -2595,13 +2914,15 @@ Grammar.extend
                 (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e));
               Gramext.Stoken ("", ";")],
              Gramext.action
-               (fun _ (e : 'expr) (loc : int * int) -> (e : 'e__12))]);
+               (fun _ (e : 'expr) (loc : Lexing.position * Lexing.position) ->
+                  (e : 'e__12))]);
        Gramext.Snterm
          (Grammar.Entry.obj
             (warning_sequence : 'warning_sequence Grammar.Entry.e));
        Gramext.Stoken ("", "done")],
       Gramext.action
-        (fun _ _ (seq : 'e__12 list) _ (e : 'expr) _ (loc : int * int) ->
+        (fun _ _ (seq : 'e__12 list) _ (e : 'expr) _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExWhi (loc, e, seq) : 'expr));
       [Gramext.Stoken ("", "for"); Gramext.Stoken ("LIDENT", "");
        Gramext.Stoken ("", "="); Gramext.Sself;
@@ -2615,14 +2936,16 @@ Grammar.extend
                 (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e));
               Gramext.Stoken ("", ";")],
              Gramext.action
-               (fun _ (e : 'expr) (loc : int * int) -> (e : 'e__11))]);
+               (fun _ (e : 'expr) (loc : Lexing.position * Lexing.position) ->
+                  (e : 'e__11))]);
        Gramext.Snterm
          (Grammar.Entry.obj
             (warning_sequence : 'warning_sequence Grammar.Entry.e));
        Gramext.Stoken ("", "done")],
       Gramext.action
         (fun _ _ (seq : 'e__11 list) _ (e2 : 'expr) (df : 'direction_flag)
-           (e1 : 'expr) _ (i : string) _ (loc : int * int) ->
+           (e1 : 'expr) _ (i : string) _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExFor (loc, i, e1, e2, df, seq) : 'expr));
       [Gramext.Stoken ("", "do");
        Gramext.Slist0
@@ -2631,21 +2954,23 @@ Grammar.extend
                 (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e));
               Gramext.Stoken ("", ";")],
              Gramext.action
-               (fun _ (e : 'expr) (loc : int * int) -> (e : 'e__10))]);
+               (fun _ (e : 'expr) (loc : Lexing.position * Lexing.position) ->
+                  (e : 'e__10))]);
        Gramext.Stoken ("", "return");
        Gramext.Snterm
          (Grammar.Entry.obj
             (warning_sequence : 'warning_sequence Grammar.Entry.e));
        Gramext.Sself],
       Gramext.action
-        (fun (e : 'expr) _ _ (seq : 'e__10 list) _ (loc : int * int) ->
+        (fun (e : 'expr) _ _ (seq : 'e__10 list) _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.ExSeq (loc, append_elem seq e) : 'expr))]];
     Grammar.Entry.obj (warning_sequence : 'warning_sequence Grammar.Entry.e),
     None,
     [None, None,
      [[],
       Gramext.action
-        (fun (loc : int * int) ->
+        (fun (loc : Lexing.position * Lexing.position) ->
            (warn_sequence loc : 'warning_sequence))]]]);;
 
 Grammar.extend
@@ -2666,20 +2991,23 @@ Grammar.extend
    [Grammar.Entry.obj (interf : 'interf Grammar.Entry.e), None,
     [None, None,
      [[Gramext.Stoken ("EOI", "")],
-      Gramext.action (fun _ (loc : int * int) -> ([], false : 'interf));
+      Gramext.action
+        (fun _ (loc : Lexing.position * Lexing.position) ->
+           ([], false : 'interf));
       [Gramext.Snterm
          (Grammar.Entry.obj (sig_item_semi : 'sig_item_semi Grammar.Entry.e));
        Gramext.Sself],
       Gramext.action
         (fun (sil, stopped : 'interf) (si : 'sig_item_semi)
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (si :: sil, stopped : 'interf));
       [Gramext.Stoken ("", "#"); Gramext.Stoken ("LIDENT", "");
        Gramext.Sopt
          (Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e)));
        Gramext.Stoken ("", ";")],
       Gramext.action
-        (fun _ (dp : 'expr option) (n : string) _ (loc : int * int) ->
+        (fun _ (dp : 'expr option) (n : string) _
+           (loc : Lexing.position * Lexing.position) ->
            ([MLast.SgDir (loc, n, dp), loc], true : 'interf))]];
     Grammar.Entry.obj (sig_item_semi : 'sig_item_semi Grammar.Entry.e), None,
     [None, None,
@@ -2687,25 +3015,28 @@ Grammar.extend
          (Grammar.Entry.obj (sig_item : 'sig_item Grammar.Entry.e));
        Gramext.Stoken ("", ";")],
       Gramext.action
-        (fun _ (si : 'sig_item) (loc : int * int) ->
+        (fun _ (si : 'sig_item) (loc : Lexing.position * Lexing.position) ->
            (si, loc : 'sig_item_semi))]];
     Grammar.Entry.obj (implem : 'implem Grammar.Entry.e), None,
     [None, None,
      [[Gramext.Stoken ("EOI", "")],
-      Gramext.action (fun _ (loc : int * int) -> ([], false : 'implem));
+      Gramext.action
+        (fun _ (loc : Lexing.position * Lexing.position) ->
+           ([], false : 'implem));
       [Gramext.Snterm
          (Grammar.Entry.obj (str_item_semi : 'str_item_semi Grammar.Entry.e));
        Gramext.Sself],
       Gramext.action
         (fun (sil, stopped : 'implem) (si : 'str_item_semi)
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (si :: sil, stopped : 'implem));
       [Gramext.Stoken ("", "#"); Gramext.Stoken ("LIDENT", "");
        Gramext.Sopt
          (Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e)));
        Gramext.Stoken ("", ";")],
       Gramext.action
-        (fun _ (dp : 'expr option) (n : string) _ (loc : int * int) ->
+        (fun _ (dp : 'expr option) (n : string) _
+           (loc : Lexing.position * Lexing.position) ->
            ([MLast.StDir (loc, n, dp), loc], true : 'implem))]];
     Grammar.Entry.obj (str_item_semi : 'str_item_semi Grammar.Entry.e), None,
     [None, None,
@@ -2713,32 +3044,38 @@ Grammar.extend
          (Grammar.Entry.obj (str_item : 'str_item Grammar.Entry.e));
        Gramext.Stoken ("", ";")],
       Gramext.action
-        (fun _ (si : 'str_item) (loc : int * int) ->
+        (fun _ (si : 'str_item) (loc : Lexing.position * Lexing.position) ->
            (si, loc : 'str_item_semi))]];
     Grammar.Entry.obj (top_phrase : 'top_phrase Grammar.Entry.e), None,
     [None, None,
      [[Gramext.Stoken ("EOI", "")],
-      Gramext.action (fun _ (loc : int * int) -> (None : 'top_phrase));
+      Gramext.action
+        (fun _ (loc : Lexing.position * Lexing.position) ->
+           (None : 'top_phrase));
       [Gramext.Snterm (Grammar.Entry.obj (phrase : 'phrase Grammar.Entry.e))],
       Gramext.action
-        (fun (ph : 'phrase) (loc : int * int) -> (Some ph : 'top_phrase))]];
+        (fun (ph : 'phrase) (loc : Lexing.position * Lexing.position) ->
+           (Some ph : 'top_phrase))]];
     Grammar.Entry.obj (use_file : 'use_file Grammar.Entry.e), None,
     [None, None,
      [[Gramext.Stoken ("EOI", "")],
-      Gramext.action (fun _ (loc : int * int) -> ([], false : 'use_file));
+      Gramext.action
+        (fun _ (loc : Lexing.position * Lexing.position) ->
+           ([], false : 'use_file));
       [Gramext.Snterm
          (Grammar.Entry.obj (str_item : 'str_item Grammar.Entry.e));
        Gramext.Stoken ("", ";"); Gramext.Sself],
       Gramext.action
         (fun (sil, stopped : 'use_file) _ (si : 'str_item)
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (si :: sil, stopped : 'use_file));
       [Gramext.Stoken ("", "#"); Gramext.Stoken ("LIDENT", "");
        Gramext.Sopt
          (Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e)));
        Gramext.Stoken ("", ";")],
       Gramext.action
-        (fun _ (dp : 'expr option) (n : string) _ (loc : int * int) ->
+        (fun _ (dp : 'expr option) (n : string) _
+           (loc : Lexing.position * Lexing.position) ->
            ([MLast.StDir (loc, n, dp)], true : 'use_file))]];
     Grammar.Entry.obj (phrase : 'phrase Grammar.Entry.e), None,
     [None, None,
@@ -2746,20 +3083,22 @@ Grammar.extend
          (Grammar.Entry.obj (str_item : 'str_item Grammar.Entry.e));
        Gramext.Stoken ("", ";")],
       Gramext.action
-        (fun _ (sti : 'str_item) (loc : int * int) -> (sti : 'phrase));
+        (fun _ (sti : 'str_item) (loc : Lexing.position * Lexing.position) ->
+           (sti : 'phrase));
       [Gramext.Stoken ("", "#"); Gramext.Stoken ("LIDENT", "");
        Gramext.Sopt
          (Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e)));
        Gramext.Stoken ("", ";")],
       Gramext.action
-        (fun _ (dp : 'expr option) (n : string) _ (loc : int * int) ->
+        (fun _ (dp : 'expr option) (n : string) _
+           (loc : Lexing.position * Lexing.position) ->
            (MLast.StDir (loc, n, dp) : 'phrase))]];
     Grammar.Entry.obj (expr : 'expr Grammar.Entry.e),
     Some (Gramext.Level "simple"),
     [None, None,
      [[Gramext.Stoken ("QUOTATION", "")],
       Gramext.action
-        (fun (x : string) (loc : int * int) ->
+        (fun (x : string) (loc : Lexing.position * Lexing.position) ->
            (let x =
               try
                 let i = String.index x ':' in
@@ -2772,14 +3111,16 @@ Grammar.extend
             'expr));
       [Gramext.Stoken ("LOCATE", "")],
       Gramext.action
-        (fun (x : string) (loc : int * int) ->
+        (fun (x : string) (loc : Lexing.position * Lexing.position) ->
            (let x =
               try
                 let i = String.index x ':' in
-                int_of_string (String.sub x 0 i),
+                {(Lexing.dummy_pos) with
+                  Lexing.pos_cnum = int_of_string (String.sub x 0 i)},
                 String.sub x (i + 1) (String.length x - i - 1)
               with
-                Not_found | Failure _ -> 0, x
+                Not_found | Failure _ ->
+                  {(Lexing.dummy_pos) with Lexing.pos_cnum = 0}, x
             in
             Pcaml.handle_expr_locate loc x :
             'expr))]];
@@ -2788,7 +3129,7 @@ Grammar.extend
     [None, None,
      [[Gramext.Stoken ("QUOTATION", "")],
       Gramext.action
-        (fun (x : string) (loc : int * int) ->
+        (fun (x : string) (loc : Lexing.position * Lexing.position) ->
            (let x =
               try
                 let i = String.index x ':' in
@@ -2801,14 +3142,16 @@ Grammar.extend
             'patt));
       [Gramext.Stoken ("LOCATE", "")],
       Gramext.action
-        (fun (x : string) (loc : int * int) ->
+        (fun (x : string) (loc : Lexing.position * Lexing.position) ->
            (let x =
               try
                 let i = String.index x ':' in
-                int_of_string (String.sub x 0 i),
+                {(Lexing.dummy_pos) with
+                  Lexing.pos_cnum = int_of_string (String.sub x 0 i)},
                 String.sub x (i + 1) (String.length x - i - 1)
               with
-                Not_found | Failure _ -> 0, x
+                Not_found | Failure _ ->
+                  {(Lexing.dummy_pos) with Lexing.pos_cnum = 0}, x
             in
             Pcaml.handle_patt_locate loc x :
             'patt))]]]);;
diff --git a/camlp4/ocaml_src/meta/pa_rp.ml b/camlp4/ocaml_src/meta/pa_rp.ml
index ad743e8708..80d49d6e16 100644
--- a/camlp4/ocaml_src/meta/pa_rp.ml
+++ b/camlp4/ocaml_src/meta/pa_rp.ml
@@ -487,7 +487,7 @@ Grammar.extend
          (Grammar.Entry.obj (parser_case : 'parser_case Grammar.Entry.e))],
       Gramext.action
         (fun (pc : 'parser_case) (po : 'ipatt option) _ _ (e : 'expr) _
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (cparser_match loc e po [pc] : 'expr));
       [Gramext.Stoken ("", "match"); Gramext.Sself;
        Gramext.Stoken ("", "with"); Gramext.Stoken ("", "parser");
@@ -502,7 +502,7 @@ Grammar.extend
        Gramext.Stoken ("", "]")],
       Gramext.action
         (fun _ (pcl : 'parser_case list) _ (po : 'ipatt option) _ _
-           (e : 'expr) _ (loc : int * int) ->
+           (e : 'expr) _ (loc : Lexing.position * Lexing.position) ->
            (cparser_match loc e po pcl : 'expr));
       [Gramext.Stoken ("", "parser");
        Gramext.Sopt
@@ -511,7 +511,8 @@ Grammar.extend
        Gramext.Snterm
          (Grammar.Entry.obj (parser_case : 'parser_case Grammar.Entry.e))],
       Gramext.action
-        (fun (pc : 'parser_case) (po : 'ipatt option) _ (loc : int * int) ->
+        (fun (pc : 'parser_case) (po : 'ipatt option) _
+           (loc : Lexing.position * Lexing.position) ->
            (cparser loc po [pc] : 'expr));
       [Gramext.Stoken ("", "parser");
        Gramext.Sopt
@@ -525,7 +526,7 @@ Grammar.extend
        Gramext.Stoken ("", "]")],
       Gramext.action
         (fun _ (pcl : 'parser_case list) _ (po : 'ipatt option) _
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (cparser loc po pcl : 'expr))]];
     Grammar.Entry.obj (parser_case : 'parser_case Grammar.Entry.e), None,
     [None, None,
@@ -540,11 +541,14 @@ Grammar.extend
        Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))],
       Gramext.action
         (fun (e : 'expr) _ (po : 'ipatt option) _ (sp : 'stream_patt) _
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (sp, po, e : 'parser_case))]];
     Grammar.Entry.obj (stream_patt : 'stream_patt Grammar.Entry.e), None,
     [None, None,
-     [[], Gramext.action (fun (loc : int * int) -> ([] : 'stream_patt));
+     [[],
+      Gramext.action
+        (fun (loc : Lexing.position * Lexing.position) ->
+           ([] : 'stream_patt));
       [Gramext.Snterm
          (Grammar.Entry.obj
             (stream_patt_comp : 'stream_patt_comp Grammar.Entry.e));
@@ -557,13 +561,14 @@ Grammar.extend
           Gramext.Stoken ("", ";"))],
       Gramext.action
         (fun (sp : 'stream_patt_comp_err list) _ (spc : 'stream_patt_comp)
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            ((spc, None) :: sp : 'stream_patt));
       [Gramext.Snterm
          (Grammar.Entry.obj
             (stream_patt_comp : 'stream_patt_comp Grammar.Entry.e))],
       Gramext.action
-        (fun (spc : 'stream_patt_comp) (loc : int * int) ->
+        (fun (spc : 'stream_patt_comp)
+           (loc : Lexing.position * Lexing.position) ->
            ([spc, None] : 'stream_patt))]];
     Grammar.Entry.obj
       (stream_patt_comp_err : 'stream_patt_comp_err Grammar.Entry.e),
@@ -578,23 +583,25 @@ Grammar.extend
               Gramext.Snterm
                 (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))],
              Gramext.action
-               (fun (e : 'expr) _ (loc : int * int) -> (e : 'e__1))])],
+               (fun (e : 'expr) _ (loc : Lexing.position * Lexing.position) ->
+                  (e : 'e__1))])],
       Gramext.action
         (fun (eo : 'e__1 option) (spc : 'stream_patt_comp)
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (spc, eo : 'stream_patt_comp_err))]];
     Grammar.Entry.obj (stream_patt_comp : 'stream_patt_comp Grammar.Entry.e),
     None,
     [None, None,
      [[Gramext.Snterm (Grammar.Entry.obj (patt : 'patt Grammar.Entry.e))],
       Gramext.action
-        (fun (p : 'patt) (loc : int * int) ->
+        (fun (p : 'patt) (loc : Lexing.position * Lexing.position) ->
            (SpStr (loc, p) : 'stream_patt_comp));
       [Gramext.Snterm (Grammar.Entry.obj (patt : 'patt Grammar.Entry.e));
        Gramext.Stoken ("", "=");
        Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))],
       Gramext.action
-        (fun (e : 'expr) _ (p : 'patt) (loc : int * int) ->
+        (fun (e : 'expr) _ (p : 'patt)
+           (loc : Lexing.position * Lexing.position) ->
            (SpNtr (loc, p, e) : 'stream_patt_comp));
       [Gramext.Stoken ("", "`");
        Gramext.Snterm (Grammar.Entry.obj (patt : 'patt Grammar.Entry.e));
@@ -604,15 +611,17 @@ Grammar.extend
               Gramext.Snterm
                 (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))],
              Gramext.action
-               (fun (e : 'expr) _ (loc : int * int) -> (e : 'e__2))])],
+               (fun (e : 'expr) _ (loc : Lexing.position * Lexing.position) ->
+                  (e : 'e__2))])],
       Gramext.action
-        (fun (eo : 'e__2 option) (p : 'patt) _ (loc : int * int) ->
+        (fun (eo : 'e__2 option) (p : 'patt) _
+           (loc : Lexing.position * Lexing.position) ->
            (SpTrm (loc, p, eo) : 'stream_patt_comp))]];
     Grammar.Entry.obj (ipatt : 'ipatt Grammar.Entry.e), None,
     [None, None,
      [[Gramext.Stoken ("LIDENT", "")],
       Gramext.action
-        (fun (i : string) (loc : int * int) ->
+        (fun (i : string) (loc : Lexing.position * Lexing.position) ->
            (MLast.PaLid (loc, i) : 'ipatt))]];
     Grammar.Entry.obj (expr : 'expr Grammar.Entry.e),
     Some (Gramext.Level "simple"),
@@ -625,17 +634,18 @@ Grammar.extend
           Gramext.Stoken ("", ";"));
        Gramext.Stoken ("", ":]")],
       Gramext.action
-        (fun _ (se : 'stream_expr_comp list) _ (loc : int * int) ->
+        (fun _ (se : 'stream_expr_comp list) _
+           (loc : Lexing.position * Lexing.position) ->
            (cstream loc se : 'expr))]];
     Grammar.Entry.obj (stream_expr_comp : 'stream_expr_comp Grammar.Entry.e),
     None,
     [None, None,
      [[Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))],
       Gramext.action
-        (fun (e : 'expr) (loc : int * int) ->
+        (fun (e : 'expr) (loc : Lexing.position * Lexing.position) ->
            (SeNtr (loc, e) : 'stream_expr_comp));
       [Gramext.Stoken ("", "`");
        Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))],
       Gramext.action
-        (fun (e : 'expr) _ (loc : int * int) ->
+        (fun (e : 'expr) _ (loc : Lexing.position * Lexing.position) ->
            (SeTrm (loc, e) : 'stream_expr_comp))]]]);;
diff --git a/camlp4/ocaml_src/meta/q_MLast.ml b/camlp4/ocaml_src/meta/q_MLast.ml
index 70540af642..dac10349dd 100644
--- a/camlp4/ocaml_src/meta/q_MLast.ml
+++ b/camlp4/ocaml_src/meta/q_MLast.ml
@@ -30,7 +30,12 @@ module Qast =
       | Loc
       | Antiquot of MLast.loc * string
     ;;
-    let loc = 0, 0;;
+    let loc =
+      let nowhere =
+        {(Lexing.dummy_pos) with Lexing.pos_lnum = 1; Lexing.pos_cnum = 0}
+      in
+      nowhere, nowhere
+    ;;
     let rec to_expr =
       function
         Node (n, al) ->
@@ -66,7 +71,9 @@ module Qast =
           let e =
             try Grammar.Entry.parse Pcaml.expr_eoi (Stream.of_string s) with
               Stdpp.Exc_located ((bp, ep), exc) ->
-                raise (Stdpp.Exc_located ((fst loc + bp, fst loc + ep), exc))
+                raise
+                  (Stdpp.Exc_located
+                     (Reloc.adjust_loc (fst loc) (bp, ep), exc))
           in
           MLast.ExAnt (loc, e)
     and to_expr_label (l, a) =
@@ -106,7 +113,9 @@ module Qast =
           let p =
             try Grammar.Entry.parse Pcaml.patt_eoi (Stream.of_string s) with
               Stdpp.Exc_located ((bp, ep), exc) ->
-                raise (Stdpp.Exc_located ((fst loc + bp, fst loc + ep), exc))
+                raise
+                  (Stdpp.Exc_located
+                     (Reloc.adjust_loc (fst loc) (bp, ep), exc))
           in
           MLast.PaAnt (loc, p)
     and to_patt_label (l, a) =
@@ -121,7 +130,7 @@ let antiquot k (bp, ep) x =
     if k = "" then String.length "$"
     else String.length "$" + String.length k + String.length ":"
   in
-  Qast.Antiquot ((shift + bp, shift + ep), x)
+  Qast.Antiquot ((Reloc.shift_pos shift bp, Reloc.shift_pos (-1) ep), x)
 ;;
 
 let sig_item = Grammar.Entry.create gram "signature item";;
@@ -149,6 +158,9 @@ let a_opt = Grammar.Entry.create gram "a_opt";;
 let a_UIDENT = Grammar.Entry.create gram "a_UIDENT";;
 let a_LIDENT = Grammar.Entry.create gram "a_LIDENT";;
 let a_INT = Grammar.Entry.create gram "a_INT";;
+let a_INT32 = Grammar.Entry.create gram "a_INT32";;
+let a_INT64 = Grammar.Entry.create gram "a_INT64";;
+let a_NATIVEINT = Grammar.Entry.create gram "a__NATIVEINT";;
 let a_FLOAT = Grammar.Entry.create gram "a_FLOAT";;
 let a_STRING = Grammar.Entry.create gram "a_STRING";;
 let a_CHAR = Grammar.Entry.create gram "a_CHAR";;
@@ -295,7 +307,7 @@ let warn_variant _ =
   if !not_yet_warned_variant then
     begin
       not_yet_warned_variant := false;
-      !(Pcaml.warning) (0, 1)
+      !(Pcaml.warning) (Lexing.dummy_pos, Reloc.shift_pos 1 Lexing.dummy_pos)
         (Printf.sprintf
            "use of syntax of variants types deprecated since version 3.05")
     end
@@ -306,7 +318,7 @@ let warn_sequence _ =
   if !not_yet_warned_seq then
     begin
       not_yet_warned_seq := false;
-      !(Pcaml.warning) (0, 1)
+      !(Pcaml.warning) (Lexing.dummy_pos, Reloc.shift_pos 1 Lexing.dummy_pos)
         (Printf.sprintf
            "use of syntax of sequences deprecated since version 3.01.1")
     end
@@ -438,18 +450,20 @@ Grammar.extend
                        (str_item : 'str_item Grammar.Entry.e));
                   Gramext.Stoken ("", ";")],
                  Gramext.action
-                   (fun _ (s : 'str_item) (loc : int * int) ->
+                   (fun _ (s : 'str_item)
+                      (loc : Lexing.position * Lexing.position) ->
                       (s : 'e__1))])],
           Gramext.action
-            (fun (a : 'e__1 list) (loc : int * int) ->
+            (fun (a : 'e__1 list) (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))];
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))];
        Gramext.Stoken ("", "end")],
       Gramext.action
-        (fun _ (st : 'a_list) _ (loc : int * int) ->
+        (fun _ (st : 'a_list) _ (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("MeStr", [Qast.Loc; st]) : 'module_expr));
       [Gramext.Stoken ("", "functor"); Gramext.Stoken ("", "(");
        Gramext.Snterm
@@ -460,22 +474,25 @@ Grammar.extend
        Gramext.Stoken ("", ")"); Gramext.Stoken ("", "->"); Gramext.Sself],
       Gramext.action
         (fun (me : 'module_expr) _ _ (t : 'module_type) _ (i : 'a_UIDENT) _ _
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("MeFun", [Qast.Loc; i; t; me]) : 'module_expr))];
      None, None,
      [[Gramext.Sself; Gramext.Sself],
       Gramext.action
-        (fun (me2 : 'module_expr) (me1 : 'module_expr) (loc : int * int) ->
+        (fun (me2 : 'module_expr) (me1 : 'module_expr)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("MeApp", [Qast.Loc; me1; me2]) : 'module_expr))];
      None, None,
      [[Gramext.Sself; Gramext.Stoken ("", "."); Gramext.Sself],
       Gramext.action
-        (fun (me2 : 'module_expr) _ (me1 : 'module_expr) (loc : int * int) ->
+        (fun (me2 : 'module_expr) _ (me1 : 'module_expr)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("MeAcc", [Qast.Loc; me1; me2]) : 'module_expr))];
      Some "simple", None,
      [[Gramext.Stoken ("", "("); Gramext.Sself; Gramext.Stoken ("", ")")],
       Gramext.action
-        (fun _ (me : 'module_expr) _ (loc : int * int) ->
+        (fun _ (me : 'module_expr) _
+           (loc : Lexing.position * Lexing.position) ->
            (me : 'module_expr));
       [Gramext.Stoken ("", "("); Gramext.Sself; Gramext.Stoken ("", ":");
        Gramext.Snterm
@@ -483,18 +500,18 @@ Grammar.extend
        Gramext.Stoken ("", ")")],
       Gramext.action
         (fun _ (mt : 'module_type) _ (me : 'module_expr) _
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("MeTyc", [Qast.Loc; me; mt]) : 'module_expr));
       [Gramext.Snterm
          (Grammar.Entry.obj (a_UIDENT : 'a_UIDENT Grammar.Entry.e))],
       Gramext.action
-        (fun (i : 'a_UIDENT) (loc : int * int) ->
+        (fun (i : 'a_UIDENT) (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("MeUid", [Qast.Loc; i]) : 'module_expr))]];
     Grammar.Entry.obj (str_item : 'str_item Grammar.Entry.e), None,
     [Some "top", None,
      [[Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))],
       Gramext.action
-        (fun (e : 'expr) (loc : int * int) ->
+        (fun (e : 'expr) (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("StExp", [Qast.Loc; e]) : 'str_item));
       [Gramext.Stoken ("", "value");
        Gramext.srules
@@ -502,15 +519,18 @@ Grammar.extend
              (Gramext.srules
                 [[Gramext.Stoken ("", "rec")],
                  Gramext.action
-                   (fun (x : string) (loc : int * int) ->
+                   (fun (x : string)
+                      (loc : Lexing.position * Lexing.position) ->
                       (Qast.Str x : 'e__3))])],
           Gramext.action
-            (fun (a : 'e__3 option) (loc : int * int) ->
+            (fun (a : 'e__3 option)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.Option a : 'a_opt));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_opt) (loc : int * int) -> (a : 'a_opt))];
+            (fun (a : 'a_opt) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_opt))];
        Gramext.srules
          [[Gramext.Slist1sep
              (Gramext.Snterm
@@ -518,14 +538,17 @@ Grammar.extend
                    (let_binding : 'let_binding Grammar.Entry.e)),
               Gramext.Stoken ("", "and"))],
           Gramext.action
-            (fun (a : 'let_binding list) (loc : int * int) ->
+            (fun (a : 'let_binding list)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))]],
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))]],
       Gramext.action
-        (fun (l : 'a_list) (r : 'a_opt) _ (loc : int * int) ->
+        (fun (l : 'a_list) (r : 'a_opt) _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("StVal", [Qast.Loc; o2b r; l]) : 'str_item));
       [Gramext.Stoken ("", "type");
        Gramext.srules
@@ -535,20 +558,22 @@ Grammar.extend
                    (type_declaration : 'type_declaration Grammar.Entry.e)),
               Gramext.Stoken ("", "and"))],
           Gramext.action
-            (fun (a : 'type_declaration list) (loc : int * int) ->
+            (fun (a : 'type_declaration list)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))]],
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))]],
       Gramext.action
-        (fun (tdl : 'a_list) _ (loc : int * int) ->
+        (fun (tdl : 'a_list) _ (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("StTyp", [Qast.Loc; tdl]) : 'str_item));
       [Gramext.Stoken ("", "open");
        Gramext.Snterm
          (Grammar.Entry.obj (mod_ident : 'mod_ident Grammar.Entry.e))],
       Gramext.action
-        (fun (i : 'mod_ident) _ (loc : int * int) ->
+        (fun (i : 'mod_ident) _ (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("StOpn", [Qast.Loc; i]) : 'str_item));
       [Gramext.Stoken ("", "module"); Gramext.Stoken ("", "type");
        Gramext.Snterm
@@ -557,7 +582,8 @@ Grammar.extend
        Gramext.Snterm
          (Grammar.Entry.obj (module_type : 'module_type Grammar.Entry.e))],
       Gramext.action
-        (fun (mt : 'module_type) _ (i : 'a_UIDENT) _ _ (loc : int * int) ->
+        (fun (mt : 'module_type) _ (i : 'a_UIDENT) _ _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("StMty", [Qast.Loc; i; mt]) : 'str_item));
       [Gramext.Stoken ("", "module"); Gramext.Stoken ("", "rec");
        Gramext.srules
@@ -568,14 +594,17 @@ Grammar.extend
                     'module_rec_binding Grammar.Entry.e)),
               Gramext.Stoken ("", "and"))],
           Gramext.action
-            (fun (a : 'module_rec_binding list) (loc : int * int) ->
+            (fun (a : 'module_rec_binding list)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))]],
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))]],
       Gramext.action
-        (fun (nmtmes : 'a_list) _ _ (loc : int * int) ->
+        (fun (nmtmes : 'a_list) _ _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("StRecMod", [Qast.Loc; nmtmes]) : 'str_item));
       [Gramext.Stoken ("", "module");
        Gramext.Snterm
@@ -584,13 +613,15 @@ Grammar.extend
          (Grammar.Entry.obj
             (module_binding : 'module_binding Grammar.Entry.e))],
       Gramext.action
-        (fun (mb : 'module_binding) (i : 'a_UIDENT) _ (loc : int * int) ->
+        (fun (mb : 'module_binding) (i : 'a_UIDENT) _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("StMod", [Qast.Loc; i; mb]) : 'str_item));
       [Gramext.Stoken ("", "include");
        Gramext.Snterm
          (Grammar.Entry.obj (module_expr : 'module_expr Grammar.Entry.e))],
       Gramext.action
-        (fun (me : 'module_expr) _ (loc : int * int) ->
+        (fun (me : 'module_expr) _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("StInc", [Qast.Loc; me]) : 'str_item));
       [Gramext.Stoken ("", "external");
        Gramext.Snterm
@@ -603,15 +634,17 @@ Grammar.extend
              (Gramext.Snterm
                 (Grammar.Entry.obj (a_STRING : 'a_STRING Grammar.Entry.e)))],
           Gramext.action
-            (fun (a : 'a_STRING list) (loc : int * int) ->
+            (fun (a : 'a_STRING list)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))]],
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))]],
       Gramext.action
         (fun (pd : 'a_list) _ (t : 'ctyp) _ (i : 'a_LIDENT) _
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("StExt", [Qast.Loc; i; t; pd]) : 'str_item));
       [Gramext.Stoken ("", "exception");
        Gramext.Snterm
@@ -622,13 +655,11 @@ Grammar.extend
          (Grammar.Entry.obj (rebind_exn : 'rebind_exn Grammar.Entry.e))],
       Gramext.action
         (fun (b : 'rebind_exn) (ctl : 'constructor_declaration) _
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (let (_, c, tl) =
               match ctl with
                 Qast.Tuple [xx1; xx2; xx3] -> xx1, xx2, xx3
-              | _ ->
-                  match () with
-                  _ -> raise (Match_failure ("q_MLast.ml", 302, 19))
+              | _ -> match () with _ -> raise (Match_failure ("", 308, 19))
             in
             Qast.Node ("StExc", [Qast.Loc; c; tl; b]) :
             'str_item));
@@ -641,28 +672,33 @@ Grammar.extend
                        (str_item : 'str_item Grammar.Entry.e));
                   Gramext.Stoken ("", ";")],
                  Gramext.action
-                   (fun _ (s : 'str_item) (loc : int * int) ->
+                   (fun _ (s : 'str_item)
+                      (loc : Lexing.position * Lexing.position) ->
                       (s : 'e__2))])],
           Gramext.action
-            (fun (a : 'e__2 list) (loc : int * int) ->
+            (fun (a : 'e__2 list) (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))];
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))];
        Gramext.Stoken ("", "end")],
       Gramext.action
-        (fun _ (st : 'a_list) _ (loc : int * int) ->
+        (fun _ (st : 'a_list) _ (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("StDcl", [Qast.Loc; st]) : 'str_item))]];
     Grammar.Entry.obj (rebind_exn : 'rebind_exn Grammar.Entry.e), None,
     [None, None,
      [[],
-      Gramext.action (fun (loc : int * int) -> (Qast.List [] : 'rebind_exn));
+      Gramext.action
+        (fun (loc : Lexing.position * Lexing.position) ->
+           (Qast.List [] : 'rebind_exn));
       [Gramext.Stoken ("", "=");
        Gramext.Snterm
          (Grammar.Entry.obj (mod_ident : 'mod_ident Grammar.Entry.e))],
       Gramext.action
-        (fun (sl : 'mod_ident) _ (loc : int * int) -> (sl : 'rebind_exn))]];
+        (fun (sl : 'mod_ident) _ (loc : Lexing.position * Lexing.position) ->
+           (sl : 'rebind_exn))]];
     Grammar.Entry.obj (module_binding : 'module_binding Grammar.Entry.e),
     None,
     [None, Some Gramext.RightA,
@@ -670,7 +706,8 @@ Grammar.extend
        Gramext.Snterm
          (Grammar.Entry.obj (module_expr : 'module_expr Grammar.Entry.e))],
       Gramext.action
-        (fun (me : 'module_expr) _ (loc : int * int) ->
+        (fun (me : 'module_expr) _
+           (loc : Lexing.position * Lexing.position) ->
            (me : 'module_binding));
       [Gramext.Stoken ("", ":");
        Gramext.Snterm
@@ -679,7 +716,8 @@ Grammar.extend
        Gramext.Snterm
          (Grammar.Entry.obj (module_expr : 'module_expr Grammar.Entry.e))],
       Gramext.action
-        (fun (me : 'module_expr) _ (mt : 'module_type) _ (loc : int * int) ->
+        (fun (me : 'module_expr) _ (mt : 'module_type) _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("MeTyc", [Qast.Loc; me; mt]) : 'module_binding));
       [Gramext.Stoken ("", "(");
        Gramext.Snterm
@@ -690,7 +728,7 @@ Grammar.extend
        Gramext.Stoken ("", ")"); Gramext.Sself],
       Gramext.action
         (fun (mb : 'module_binding) _ (mt : 'module_type) _ (m : 'a_UIDENT) _
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("MeFun", [Qast.Loc; m; mt; mb]) : 'module_binding))]];
     Grammar.Entry.obj
       (module_rec_binding : 'module_rec_binding Grammar.Entry.e),
@@ -706,7 +744,7 @@ Grammar.extend
          (Grammar.Entry.obj (module_expr : 'module_expr Grammar.Entry.e))],
       Gramext.action
         (fun (me : 'module_expr) _ (mt : 'module_type) _ (m : 'a_UIDENT)
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Tuple [m; me; mt] : 'module_rec_binding))]];
     Grammar.Entry.obj (module_type : 'module_type Grammar.Entry.e), None,
     [None, None,
@@ -717,7 +755,7 @@ Grammar.extend
        Gramext.Stoken ("", "->"); Gramext.Sself],
       Gramext.action
         (fun (mt : 'module_type) _ _ (t : 'module_type) _ (i : 'a_UIDENT) _ _
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("MtFun", [Qast.Loc; i; t; mt]) : 'module_type))];
      None, None,
      [[Gramext.Sself; Gramext.Stoken ("", "with");
@@ -728,14 +766,17 @@ Grammar.extend
                    (with_constr : 'with_constr Grammar.Entry.e)),
               Gramext.Stoken ("", "and"))],
           Gramext.action
-            (fun (a : 'with_constr list) (loc : int * int) ->
+            (fun (a : 'with_constr list)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))]],
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))]],
       Gramext.action
-        (fun (wcl : 'a_list) _ (mt : 'module_type) (loc : int * int) ->
+        (fun (wcl : 'a_list) _ (mt : 'module_type)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("MtWit", [Qast.Loc; mt; wcl]) : 'module_type))];
      None, None,
      [[Gramext.Stoken ("", "sig");
@@ -747,48 +788,53 @@ Grammar.extend
                        (sig_item : 'sig_item Grammar.Entry.e));
                   Gramext.Stoken ("", ";")],
                  Gramext.action
-                   (fun _ (s : 'sig_item) (loc : int * int) ->
+                   (fun _ (s : 'sig_item)
+                      (loc : Lexing.position * Lexing.position) ->
                       (s : 'e__4))])],
           Gramext.action
-            (fun (a : 'e__4 list) (loc : int * int) ->
+            (fun (a : 'e__4 list) (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))];
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))];
        Gramext.Stoken ("", "end")],
       Gramext.action
-        (fun _ (sg : 'a_list) _ (loc : int * int) ->
+        (fun _ (sg : 'a_list) _ (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("MtSig", [Qast.Loc; sg]) : 'module_type))];
      None, None,
      [[Gramext.Sself; Gramext.Sself],
       Gramext.action
-        (fun (m2 : 'module_type) (m1 : 'module_type) (loc : int * int) ->
+        (fun (m2 : 'module_type) (m1 : 'module_type)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("MtApp", [Qast.Loc; m1; m2]) : 'module_type))];
      None, None,
      [[Gramext.Sself; Gramext.Stoken ("", "."); Gramext.Sself],
       Gramext.action
-        (fun (m2 : 'module_type) _ (m1 : 'module_type) (loc : int * int) ->
+        (fun (m2 : 'module_type) _ (m1 : 'module_type)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("MtAcc", [Qast.Loc; m1; m2]) : 'module_type))];
      Some "simple", None,
      [[Gramext.Stoken ("", "("); Gramext.Sself; Gramext.Stoken ("", ")")],
       Gramext.action
-        (fun _ (mt : 'module_type) _ (loc : int * int) ->
+        (fun _ (mt : 'module_type) _
+           (loc : Lexing.position * Lexing.position) ->
            (mt : 'module_type));
       [Gramext.Stoken ("", "'");
        Gramext.Snterm (Grammar.Entry.obj (ident : 'ident Grammar.Entry.e))],
       Gramext.action
-        (fun (i : 'ident) _ (loc : int * int) ->
+        (fun (i : 'ident) _ (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("MtQuo", [Qast.Loc; i]) : 'module_type));
       [Gramext.Snterm
          (Grammar.Entry.obj (a_LIDENT : 'a_LIDENT Grammar.Entry.e))],
       Gramext.action
-        (fun (i : 'a_LIDENT) (loc : int * int) ->
+        (fun (i : 'a_LIDENT) (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("MtLid", [Qast.Loc; i]) : 'module_type));
       [Gramext.Snterm
          (Grammar.Entry.obj (a_UIDENT : 'a_UIDENT Grammar.Entry.e))],
       Gramext.action
-        (fun (i : 'a_UIDENT) (loc : int * int) ->
+        (fun (i : 'a_UIDENT) (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("MtUid", [Qast.Loc; i]) : 'module_type))]];
     Grammar.Entry.obj (sig_item : 'sig_item Grammar.Entry.e), None,
     [Some "top", None,
@@ -798,7 +844,8 @@ Grammar.extend
        Gramext.Stoken ("", ":");
        Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))],
       Gramext.action
-        (fun (t : 'ctyp) _ (i : 'a_LIDENT) _ (loc : int * int) ->
+        (fun (t : 'ctyp) _ (i : 'a_LIDENT) _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("SgVal", [Qast.Loc; i; t]) : 'sig_item));
       [Gramext.Stoken ("", "type");
        Gramext.srules
@@ -808,20 +855,22 @@ Grammar.extend
                    (type_declaration : 'type_declaration Grammar.Entry.e)),
               Gramext.Stoken ("", "and"))],
           Gramext.action
-            (fun (a : 'type_declaration list) (loc : int * int) ->
+            (fun (a : 'type_declaration list)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))]],
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))]],
       Gramext.action
-        (fun (tdl : 'a_list) _ (loc : int * int) ->
+        (fun (tdl : 'a_list) _ (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("SgTyp", [Qast.Loc; tdl]) : 'sig_item));
       [Gramext.Stoken ("", "open");
        Gramext.Snterm
          (Grammar.Entry.obj (mod_ident : 'mod_ident Grammar.Entry.e))],
       Gramext.action
-        (fun (i : 'mod_ident) _ (loc : int * int) ->
+        (fun (i : 'mod_ident) _ (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("SgOpn", [Qast.Loc; i]) : 'sig_item));
       [Gramext.Stoken ("", "module"); Gramext.Stoken ("", "rec");
        Gramext.srules
@@ -832,14 +881,16 @@ Grammar.extend
                     'module_rec_declaration Grammar.Entry.e)),
               Gramext.Stoken ("", "and"))],
           Gramext.action
-            (fun (a : 'module_rec_declaration list) (loc : int * int) ->
+            (fun (a : 'module_rec_declaration list)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))]],
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))]],
       Gramext.action
-        (fun (mds : 'a_list) _ _ (loc : int * int) ->
+        (fun (mds : 'a_list) _ _ (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("SgRecMod", [Qast.Loc; mds]) : 'sig_item));
       [Gramext.Stoken ("", "module"); Gramext.Stoken ("", "type");
        Gramext.Snterm
@@ -848,7 +899,8 @@ Grammar.extend
        Gramext.Snterm
          (Grammar.Entry.obj (module_type : 'module_type Grammar.Entry.e))],
       Gramext.action
-        (fun (mt : 'module_type) _ (i : 'a_UIDENT) _ _ (loc : int * int) ->
+        (fun (mt : 'module_type) _ (i : 'a_UIDENT) _ _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("SgMty", [Qast.Loc; i; mt]) : 'sig_item));
       [Gramext.Stoken ("", "module");
        Gramext.Snterm
@@ -857,13 +909,15 @@ Grammar.extend
          (Grammar.Entry.obj
             (module_declaration : 'module_declaration Grammar.Entry.e))],
       Gramext.action
-        (fun (mt : 'module_declaration) (i : 'a_UIDENT) _ (loc : int * int) ->
+        (fun (mt : 'module_declaration) (i : 'a_UIDENT) _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("SgMod", [Qast.Loc; i; mt]) : 'sig_item));
       [Gramext.Stoken ("", "include");
        Gramext.Snterm
          (Grammar.Entry.obj (module_type : 'module_type Grammar.Entry.e))],
       Gramext.action
-        (fun (mt : 'module_type) _ (loc : int * int) ->
+        (fun (mt : 'module_type) _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("SgInc", [Qast.Loc; mt]) : 'sig_item));
       [Gramext.Stoken ("", "external");
        Gramext.Snterm
@@ -876,15 +930,17 @@ Grammar.extend
              (Gramext.Snterm
                 (Grammar.Entry.obj (a_STRING : 'a_STRING Grammar.Entry.e)))],
           Gramext.action
-            (fun (a : 'a_STRING list) (loc : int * int) ->
+            (fun (a : 'a_STRING list)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))]],
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))]],
       Gramext.action
         (fun (pd : 'a_list) _ (t : 'ctyp) _ (i : 'a_LIDENT) _
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("SgExt", [Qast.Loc; i; t; pd]) : 'sig_item));
       [Gramext.Stoken ("", "exception");
        Gramext.Snterm
@@ -892,13 +948,12 @@ Grammar.extend
             (constructor_declaration :
              'constructor_declaration Grammar.Entry.e))],
       Gramext.action
-        (fun (ctl : 'constructor_declaration) _ (loc : int * int) ->
+        (fun (ctl : 'constructor_declaration) _
+           (loc : Lexing.position * Lexing.position) ->
            (let (_, c, tl) =
               match ctl with
                 Qast.Tuple [xx1; xx2; xx3] -> xx1, xx2, xx3
-              | _ ->
-                  match () with
-                  _ -> raise (Match_failure ("q_MLast.ml", 360, 19))
+              | _ -> match () with _ -> raise (Match_failure ("", 366, 19))
             in
             Qast.Node ("SgExc", [Qast.Loc; c; tl]) :
             'sig_item));
@@ -911,18 +966,20 @@ Grammar.extend
                        (sig_item : 'sig_item Grammar.Entry.e));
                   Gramext.Stoken ("", ";")],
                  Gramext.action
-                   (fun _ (s : 'sig_item) (loc : int * int) ->
+                   (fun _ (s : 'sig_item)
+                      (loc : Lexing.position * Lexing.position) ->
                       (s : 'e__5))])],
           Gramext.action
-            (fun (a : 'e__5 list) (loc : int * int) ->
+            (fun (a : 'e__5 list) (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))];
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))];
        Gramext.Stoken ("", "end")],
       Gramext.action
-        (fun _ (st : 'a_list) _ (loc : int * int) ->
+        (fun _ (st : 'a_list) _ (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("SgDcl", [Qast.Loc; st]) : 'sig_item))]];
     Grammar.Entry.obj
       (module_declaration : 'module_declaration Grammar.Entry.e),
@@ -937,13 +994,14 @@ Grammar.extend
        Gramext.Stoken ("", ")"); Gramext.Sself],
       Gramext.action
         (fun (mt : 'module_declaration) _ (t : 'module_type) _ (i : 'a_UIDENT)
-           _ (loc : int * int) ->
+           _ (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("MtFun", [Qast.Loc; i; t; mt]) : 'module_declaration));
       [Gramext.Stoken ("", ":");
        Gramext.Snterm
          (Grammar.Entry.obj (module_type : 'module_type Grammar.Entry.e))],
       Gramext.action
-        (fun (mt : 'module_type) _ (loc : int * int) ->
+        (fun (mt : 'module_type) _
+           (loc : Lexing.position * Lexing.position) ->
            (mt : 'module_declaration))]];
     Grammar.Entry.obj
       (module_rec_declaration : 'module_rec_declaration Grammar.Entry.e),
@@ -955,7 +1013,8 @@ Grammar.extend
        Gramext.Snterm
          (Grammar.Entry.obj (module_type : 'module_type Grammar.Entry.e))],
       Gramext.action
-        (fun (mt : 'module_type) _ (m : 'a_UIDENT) (loc : int * int) ->
+        (fun (mt : 'module_type) _ (m : 'a_UIDENT)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Tuple [m; mt] : 'module_rec_declaration))]];
     Grammar.Entry.obj (with_constr : 'with_constr Grammar.Entry.e), None,
     [None, None,
@@ -966,7 +1025,8 @@ Grammar.extend
        Gramext.Snterm
          (Grammar.Entry.obj (module_expr : 'module_expr Grammar.Entry.e))],
       Gramext.action
-        (fun (me : 'module_expr) _ (i : 'mod_ident) _ (loc : int * int) ->
+        (fun (me : 'module_expr) _ (i : 'mod_ident) _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("WcMod", [Qast.Loc; i; me]) : 'with_constr));
       [Gramext.Stoken ("", "type");
        Gramext.Snterm
@@ -977,17 +1037,19 @@ Grammar.extend
                 (Grammar.Entry.obj
                    (type_parameter : 'type_parameter Grammar.Entry.e)))],
           Gramext.action
-            (fun (a : 'type_parameter list) (loc : int * int) ->
+            (fun (a : 'type_parameter list)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))];
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))];
        Gramext.Stoken ("", "=");
        Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))],
       Gramext.action
         (fun (t : 'ctyp) _ (tpl : 'a_list) (i : 'mod_ident) _
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("WcTyp", [Qast.Loc; i; tpl; t]) : 'with_constr))]];
     Grammar.Entry.obj (expr : 'expr Grammar.Entry.e), None,
     [Some "top", Some Gramext.RightA,
@@ -997,7 +1059,8 @@ Grammar.extend
          (Grammar.Entry.obj (sequence : 'sequence Grammar.Entry.e));
        Gramext.Stoken ("", "}")],
       Gramext.action
-        (fun _ (seq : 'sequence) _ _ (e : 'expr) _ (loc : int * int) ->
+        (fun _ (seq : 'sequence) _ _ (e : 'expr) _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("ExWhi", [Qast.Loc; e; seq]) : 'expr));
       [Gramext.Stoken ("", "for");
        Gramext.Snterm
@@ -1012,25 +1075,29 @@ Grammar.extend
        Gramext.Stoken ("", "}")],
       Gramext.action
         (fun _ (seq : 'sequence) _ _ (e2 : 'expr) (df : 'direction_flag)
-           (e1 : 'expr) _ (i : 'a_LIDENT) _ (loc : int * int) ->
+           (e1 : 'expr) _ (i : 'a_LIDENT) _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("ExFor", [Qast.Loc; i; e1; e2; df; seq]) : 'expr));
       [Gramext.Stoken ("", "do"); Gramext.Stoken ("", "{");
        Gramext.Snterm
          (Grammar.Entry.obj (sequence : 'sequence Grammar.Entry.e));
        Gramext.Stoken ("", "}")],
       Gramext.action
-        (fun _ (seq : 'sequence) _ _ (loc : int * int) ->
+        (fun _ (seq : 'sequence) _ _
+           (loc : Lexing.position * Lexing.position) ->
            (mksequence Qast.Loc seq : 'expr));
       [Gramext.Stoken ("", "if"); Gramext.Sself; Gramext.Stoken ("", "then");
        Gramext.Sself; Gramext.Stoken ("", "else"); Gramext.Sself],
       Gramext.action
-        (fun (e3 : 'expr) _ (e2 : 'expr) _ (e1 : 'expr) _ (loc : int * int) ->
+        (fun (e3 : 'expr) _ (e2 : 'expr) _ (e1 : 'expr) _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("ExIfe", [Qast.Loc; e1; e2; e3]) : 'expr));
       [Gramext.Stoken ("", "try"); Gramext.Sself; Gramext.Stoken ("", "with");
        Gramext.Snterm (Grammar.Entry.obj (ipatt : 'ipatt Grammar.Entry.e));
        Gramext.Stoken ("", "->"); Gramext.Sself],
       Gramext.action
-        (fun (e1 : 'expr) _ (p1 : 'ipatt) _ (e : 'expr) _ (loc : int * int) ->
+        (fun (e1 : 'expr) _ (p1 : 'ipatt) _ (e : 'expr) _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node
               ("ExTry",
                [Qast.Loc; e;
@@ -1045,22 +1112,26 @@ Grammar.extend
                    (match_case : 'match_case Grammar.Entry.e)),
               Gramext.Stoken ("", "|"))],
           Gramext.action
-            (fun (a : 'match_case list) (loc : int * int) ->
+            (fun (a : 'match_case list)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))];
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))];
        Gramext.Stoken ("", "]")],
       Gramext.action
-        (fun _ (l : 'a_list) _ _ (e : 'expr) _ (loc : int * int) ->
+        (fun _ (l : 'a_list) _ _ (e : 'expr) _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("ExTry", [Qast.Loc; e; l]) : 'expr));
       [Gramext.Stoken ("", "match"); Gramext.Sself;
        Gramext.Stoken ("", "with");
        Gramext.Snterm (Grammar.Entry.obj (ipatt : 'ipatt Grammar.Entry.e));
        Gramext.Stoken ("", "->"); Gramext.Sself],
       Gramext.action
-        (fun (e1 : 'expr) _ (p1 : 'ipatt) _ (e : 'expr) _ (loc : int * int) ->
+        (fun (e1 : 'expr) _ (p1 : 'ipatt) _ (e : 'expr) _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node
               ("ExMat",
                [Qast.Loc; e;
@@ -1075,22 +1146,26 @@ Grammar.extend
                    (match_case : 'match_case Grammar.Entry.e)),
               Gramext.Stoken ("", "|"))],
           Gramext.action
-            (fun (a : 'match_case list) (loc : int * int) ->
+            (fun (a : 'match_case list)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))];
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))];
        Gramext.Stoken ("", "]")],
       Gramext.action
-        (fun _ (l : 'a_list) _ _ (e : 'expr) _ (loc : int * int) ->
+        (fun _ (l : 'a_list) _ _ (e : 'expr) _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("ExMat", [Qast.Loc; e; l]) : 'expr));
       [Gramext.Stoken ("", "fun");
        Gramext.Snterm (Grammar.Entry.obj (ipatt : 'ipatt Grammar.Entry.e));
        Gramext.Snterm
          (Grammar.Entry.obj (fun_def : 'fun_def Grammar.Entry.e))],
       Gramext.action
-        (fun (e : 'fun_def) (p : 'ipatt) _ (loc : int * int) ->
+        (fun (e : 'fun_def) (p : 'ipatt) _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node
               ("ExFun",
                [Qast.Loc; Qast.List [Qast.Tuple [p; Qast.Option None; e]]]) :
@@ -1103,15 +1178,17 @@ Grammar.extend
                    (match_case : 'match_case Grammar.Entry.e)),
               Gramext.Stoken ("", "|"))],
           Gramext.action
-            (fun (a : 'match_case list) (loc : int * int) ->
+            (fun (a : 'match_case list)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))];
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))];
        Gramext.Stoken ("", "]")],
       Gramext.action
-        (fun _ (l : 'a_list) _ _ (loc : int * int) ->
+        (fun _ (l : 'a_list) _ _ (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("ExFun", [Qast.Loc; l]) : 'expr));
       [Gramext.Stoken ("", "let"); Gramext.Stoken ("", "module");
        Gramext.Snterm
@@ -1122,7 +1199,7 @@ Grammar.extend
        Gramext.Stoken ("", "in"); Gramext.Sself],
       Gramext.action
         (fun (e : 'expr) _ (mb : 'module_binding) (m : 'a_UIDENT) _ _
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("ExLmd", [Qast.Loc; m; mb; e]) : 'expr));
       [Gramext.Stoken ("", "let");
        Gramext.srules
@@ -1130,15 +1207,18 @@ Grammar.extend
              (Gramext.srules
                 [[Gramext.Stoken ("", "rec")],
                  Gramext.action
-                   (fun (x : string) (loc : int * int) ->
+                   (fun (x : string)
+                      (loc : Lexing.position * Lexing.position) ->
                       (Qast.Str x : 'e__6))])],
           Gramext.action
-            (fun (a : 'e__6 option) (loc : int * int) ->
+            (fun (a : 'e__6 option)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.Option a : 'a_opt));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_opt) (loc : int * int) -> (a : 'a_opt))];
+            (fun (a : 'a_opt) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_opt))];
        Gramext.srules
          [[Gramext.Slist1sep
              (Gramext.Snterm
@@ -1146,15 +1226,18 @@ Grammar.extend
                    (let_binding : 'let_binding Grammar.Entry.e)),
               Gramext.Stoken ("", "and"))],
           Gramext.action
-            (fun (a : 'let_binding list) (loc : int * int) ->
+            (fun (a : 'let_binding list)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))];
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))];
        Gramext.Stoken ("", "in"); Gramext.Sself],
       Gramext.action
-        (fun (x : 'expr) _ (l : 'a_list) (r : 'a_opt) _ (loc : int * int) ->
+        (fun (x : 'expr) _ (l : 'a_list) (r : 'a_opt) _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("ExLet", [Qast.Loc; o2b r; l; x]) : 'expr))];
      Some "where", None,
      [[Gramext.Sself; Gramext.Stoken ("", "where");
@@ -1163,32 +1246,37 @@ Grammar.extend
              (Gramext.srules
                 [[Gramext.Stoken ("", "rec")],
                  Gramext.action
-                   (fun (x : string) (loc : int * int) ->
+                   (fun (x : string)
+                      (loc : Lexing.position * Lexing.position) ->
                       (Qast.Str x : 'e__7))])],
           Gramext.action
-            (fun (a : 'e__7 option) (loc : int * int) ->
+            (fun (a : 'e__7 option)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.Option a : 'a_opt));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_opt) (loc : int * int) -> (a : 'a_opt))];
+            (fun (a : 'a_opt) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_opt))];
        Gramext.Snterm
          (Grammar.Entry.obj (let_binding : 'let_binding Grammar.Entry.e))],
       Gramext.action
         (fun (lb : 'let_binding) (rf : 'a_opt) _ (e : 'expr)
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("ExLet", [Qast.Loc; o2b rf; Qast.List [lb]; e]) :
             'expr))];
      Some ":=", Some Gramext.NonA,
      [[Gramext.Sself; Gramext.Stoken ("", ":="); Gramext.Sself;
        Gramext.Snterm (Grammar.Entry.obj (dummy : 'dummy Grammar.Entry.e))],
       Gramext.action
-        (fun _ (e2 : 'expr) _ (e1 : 'expr) (loc : int * int) ->
+        (fun _ (e2 : 'expr) _ (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("ExAss", [Qast.Loc; e1; e2]) : 'expr))];
      Some "||", Some Gramext.RightA,
      [[Gramext.Sself; Gramext.Stoken ("", "||"); Gramext.Sself],
       Gramext.action
-        (fun (e2 : 'expr) _ (e1 : 'expr) (loc : int * int) ->
+        (fun (e2 : 'expr) _ (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node
               ("ExApp",
                [Qast.Loc;
@@ -1201,7 +1289,8 @@ Grammar.extend
      Some "&&", Some Gramext.RightA,
      [[Gramext.Sself; Gramext.Stoken ("", "&&"); Gramext.Sself],
       Gramext.action
-        (fun (e2 : 'expr) _ (e1 : 'expr) (loc : int * int) ->
+        (fun (e2 : 'expr) _ (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node
               ("ExApp",
                [Qast.Loc;
@@ -1214,7 +1303,8 @@ Grammar.extend
      Some "<", Some Gramext.LeftA,
      [[Gramext.Sself; Gramext.Stoken ("", "!="); Gramext.Sself],
       Gramext.action
-        (fun (e2 : 'expr) _ (e1 : 'expr) (loc : int * int) ->
+        (fun (e2 : 'expr) _ (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node
               ("ExApp",
                [Qast.Loc;
@@ -1226,7 +1316,8 @@ Grammar.extend
             'expr));
       [Gramext.Sself; Gramext.Stoken ("", "=="); Gramext.Sself],
       Gramext.action
-        (fun (e2 : 'expr) _ (e1 : 'expr) (loc : int * int) ->
+        (fun (e2 : 'expr) _ (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node
               ("ExApp",
                [Qast.Loc;
@@ -1238,7 +1329,8 @@ Grammar.extend
             'expr));
       [Gramext.Sself; Gramext.Stoken ("", "<>"); Gramext.Sself],
       Gramext.action
-        (fun (e2 : 'expr) _ (e1 : 'expr) (loc : int * int) ->
+        (fun (e2 : 'expr) _ (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node
               ("ExApp",
                [Qast.Loc;
@@ -1250,7 +1342,8 @@ Grammar.extend
             'expr));
       [Gramext.Sself; Gramext.Stoken ("", "="); Gramext.Sself],
       Gramext.action
-        (fun (e2 : 'expr) _ (e1 : 'expr) (loc : int * int) ->
+        (fun (e2 : 'expr) _ (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node
               ("ExApp",
                [Qast.Loc;
@@ -1262,7 +1355,8 @@ Grammar.extend
             'expr));
       [Gramext.Sself; Gramext.Stoken ("", ">="); Gramext.Sself],
       Gramext.action
-        (fun (e2 : 'expr) _ (e1 : 'expr) (loc : int * int) ->
+        (fun (e2 : 'expr) _ (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node
               ("ExApp",
                [Qast.Loc;
@@ -1274,7 +1368,8 @@ Grammar.extend
             'expr));
       [Gramext.Sself; Gramext.Stoken ("", "<="); Gramext.Sself],
       Gramext.action
-        (fun (e2 : 'expr) _ (e1 : 'expr) (loc : int * int) ->
+        (fun (e2 : 'expr) _ (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node
               ("ExApp",
                [Qast.Loc;
@@ -1286,7 +1381,8 @@ Grammar.extend
             'expr));
       [Gramext.Sself; Gramext.Stoken ("", ">"); Gramext.Sself],
       Gramext.action
-        (fun (e2 : 'expr) _ (e1 : 'expr) (loc : int * int) ->
+        (fun (e2 : 'expr) _ (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node
               ("ExApp",
                [Qast.Loc;
@@ -1298,7 +1394,8 @@ Grammar.extend
             'expr));
       [Gramext.Sself; Gramext.Stoken ("", "<"); Gramext.Sself],
       Gramext.action
-        (fun (e2 : 'expr) _ (e1 : 'expr) (loc : int * int) ->
+        (fun (e2 : 'expr) _ (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node
               ("ExApp",
                [Qast.Loc;
@@ -1311,7 +1408,8 @@ Grammar.extend
      Some "^", Some Gramext.RightA,
      [[Gramext.Sself; Gramext.Stoken ("", "@"); Gramext.Sself],
       Gramext.action
-        (fun (e2 : 'expr) _ (e1 : 'expr) (loc : int * int) ->
+        (fun (e2 : 'expr) _ (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node
               ("ExApp",
                [Qast.Loc;
@@ -1323,7 +1421,8 @@ Grammar.extend
             'expr));
       [Gramext.Sself; Gramext.Stoken ("", "^"); Gramext.Sself],
       Gramext.action
-        (fun (e2 : 'expr) _ (e1 : 'expr) (loc : int * int) ->
+        (fun (e2 : 'expr) _ (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node
               ("ExApp",
                [Qast.Loc;
@@ -1336,7 +1435,8 @@ Grammar.extend
      Some "+", Some Gramext.LeftA,
      [[Gramext.Sself; Gramext.Stoken ("", "-."); Gramext.Sself],
       Gramext.action
-        (fun (e2 : 'expr) _ (e1 : 'expr) (loc : int * int) ->
+        (fun (e2 : 'expr) _ (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node
               ("ExApp",
                [Qast.Loc;
@@ -1348,7 +1448,8 @@ Grammar.extend
             'expr));
       [Gramext.Sself; Gramext.Stoken ("", "+."); Gramext.Sself],
       Gramext.action
-        (fun (e2 : 'expr) _ (e1 : 'expr) (loc : int * int) ->
+        (fun (e2 : 'expr) _ (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node
               ("ExApp",
                [Qast.Loc;
@@ -1360,7 +1461,8 @@ Grammar.extend
             'expr));
       [Gramext.Sself; Gramext.Stoken ("", "-"); Gramext.Sself],
       Gramext.action
-        (fun (e2 : 'expr) _ (e1 : 'expr) (loc : int * int) ->
+        (fun (e2 : 'expr) _ (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node
               ("ExApp",
                [Qast.Loc;
@@ -1372,7 +1474,8 @@ Grammar.extend
             'expr));
       [Gramext.Sself; Gramext.Stoken ("", "+"); Gramext.Sself],
       Gramext.action
-        (fun (e2 : 'expr) _ (e1 : 'expr) (loc : int * int) ->
+        (fun (e2 : 'expr) _ (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node
               ("ExApp",
                [Qast.Loc;
@@ -1385,7 +1488,8 @@ Grammar.extend
      Some "*", Some Gramext.LeftA,
      [[Gramext.Sself; Gramext.Stoken ("", "mod"); Gramext.Sself],
       Gramext.action
-        (fun (e2 : 'expr) _ (e1 : 'expr) (loc : int * int) ->
+        (fun (e2 : 'expr) _ (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node
               ("ExApp",
                [Qast.Loc;
@@ -1397,7 +1501,8 @@ Grammar.extend
             'expr));
       [Gramext.Sself; Gramext.Stoken ("", "lxor"); Gramext.Sself],
       Gramext.action
-        (fun (e2 : 'expr) _ (e1 : 'expr) (loc : int * int) ->
+        (fun (e2 : 'expr) _ (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node
               ("ExApp",
                [Qast.Loc;
@@ -1409,7 +1514,8 @@ Grammar.extend
             'expr));
       [Gramext.Sself; Gramext.Stoken ("", "lor"); Gramext.Sself],
       Gramext.action
-        (fun (e2 : 'expr) _ (e1 : 'expr) (loc : int * int) ->
+        (fun (e2 : 'expr) _ (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node
               ("ExApp",
                [Qast.Loc;
@@ -1421,7 +1527,8 @@ Grammar.extend
             'expr));
       [Gramext.Sself; Gramext.Stoken ("", "land"); Gramext.Sself],
       Gramext.action
-        (fun (e2 : 'expr) _ (e1 : 'expr) (loc : int * int) ->
+        (fun (e2 : 'expr) _ (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node
               ("ExApp",
                [Qast.Loc;
@@ -1433,7 +1540,8 @@ Grammar.extend
             'expr));
       [Gramext.Sself; Gramext.Stoken ("", "/."); Gramext.Sself],
       Gramext.action
-        (fun (e2 : 'expr) _ (e1 : 'expr) (loc : int * int) ->
+        (fun (e2 : 'expr) _ (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node
               ("ExApp",
                [Qast.Loc;
@@ -1445,7 +1553,8 @@ Grammar.extend
             'expr));
       [Gramext.Sself; Gramext.Stoken ("", "*."); Gramext.Sself],
       Gramext.action
-        (fun (e2 : 'expr) _ (e1 : 'expr) (loc : int * int) ->
+        (fun (e2 : 'expr) _ (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node
               ("ExApp",
                [Qast.Loc;
@@ -1457,7 +1566,8 @@ Grammar.extend
             'expr));
       [Gramext.Sself; Gramext.Stoken ("", "/"); Gramext.Sself],
       Gramext.action
-        (fun (e2 : 'expr) _ (e1 : 'expr) (loc : int * int) ->
+        (fun (e2 : 'expr) _ (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node
               ("ExApp",
                [Qast.Loc;
@@ -1469,7 +1579,8 @@ Grammar.extend
             'expr));
       [Gramext.Sself; Gramext.Stoken ("", "*"); Gramext.Sself],
       Gramext.action
-        (fun (e2 : 'expr) _ (e1 : 'expr) (loc : int * int) ->
+        (fun (e2 : 'expr) _ (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node
               ("ExApp",
                [Qast.Loc;
@@ -1482,7 +1593,8 @@ Grammar.extend
      Some "**", Some Gramext.RightA,
      [[Gramext.Sself; Gramext.Stoken ("", "lsr"); Gramext.Sself],
       Gramext.action
-        (fun (e2 : 'expr) _ (e1 : 'expr) (loc : int * int) ->
+        (fun (e2 : 'expr) _ (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node
               ("ExApp",
                [Qast.Loc;
@@ -1494,7 +1606,8 @@ Grammar.extend
             'expr));
       [Gramext.Sself; Gramext.Stoken ("", "lsl"); Gramext.Sself],
       Gramext.action
-        (fun (e2 : 'expr) _ (e1 : 'expr) (loc : int * int) ->
+        (fun (e2 : 'expr) _ (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node
               ("ExApp",
                [Qast.Loc;
@@ -1506,7 +1619,8 @@ Grammar.extend
             'expr));
       [Gramext.Sself; Gramext.Stoken ("", "asr"); Gramext.Sself],
       Gramext.action
-        (fun (e2 : 'expr) _ (e1 : 'expr) (loc : int * int) ->
+        (fun (e2 : 'expr) _ (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node
               ("ExApp",
                [Qast.Loc;
@@ -1518,7 +1632,8 @@ Grammar.extend
             'expr));
       [Gramext.Sself; Gramext.Stoken ("", "**"); Gramext.Sself],
       Gramext.action
-        (fun (e2 : 'expr) _ (e1 : 'expr) (loc : int * int) ->
+        (fun (e2 : 'expr) _ (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node
               ("ExApp",
                [Qast.Loc;
@@ -1531,44 +1646,48 @@ Grammar.extend
      Some "unary minus", Some Gramext.NonA,
      [[Gramext.Stoken ("", "-."); Gramext.Sself],
       Gramext.action
-        (fun (e : 'expr) _ (loc : int * int) ->
+        (fun (e : 'expr) _ (loc : Lexing.position * Lexing.position) ->
            (mkumin Qast.Loc (Qast.Str "-.") e : 'expr));
       [Gramext.Stoken ("", "-"); Gramext.Sself],
       Gramext.action
-        (fun (e : 'expr) _ (loc : int * int) ->
+        (fun (e : 'expr) _ (loc : Lexing.position * Lexing.position) ->
            (mkumin Qast.Loc (Qast.Str "-") e : 'expr))];
      Some "apply", Some Gramext.LeftA,
      [[Gramext.Stoken ("", "lazy"); Gramext.Sself],
       Gramext.action
-        (fun (e : 'expr) _ (loc : int * int) ->
+        (fun (e : 'expr) _ (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("ExLaz", [Qast.Loc; e]) : 'expr));
       [Gramext.Stoken ("", "assert"); Gramext.Sself],
       Gramext.action
-        (fun (e : 'expr) _ (loc : int * int) ->
+        (fun (e : 'expr) _ (loc : Lexing.position * Lexing.position) ->
            (mkassert Qast.Loc e : 'expr));
       [Gramext.Sself; Gramext.Sself],
       Gramext.action
-        (fun (e2 : 'expr) (e1 : 'expr) (loc : int * int) ->
+        (fun (e2 : 'expr) (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("ExApp", [Qast.Loc; e1; e2]) : 'expr))];
      Some ".", Some Gramext.LeftA,
      [[Gramext.Sself; Gramext.Stoken ("", "."); Gramext.Sself],
       Gramext.action
-        (fun (e2 : 'expr) _ (e1 : 'expr) (loc : int * int) ->
+        (fun (e2 : 'expr) _ (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("ExAcc", [Qast.Loc; e1; e2]) : 'expr));
       [Gramext.Sself; Gramext.Stoken ("", "."); Gramext.Stoken ("", "[");
        Gramext.Sself; Gramext.Stoken ("", "]")],
       Gramext.action
-        (fun _ (e2 : 'expr) _ _ (e1 : 'expr) (loc : int * int) ->
+        (fun _ (e2 : 'expr) _ _ (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("ExSte", [Qast.Loc; e1; e2]) : 'expr));
       [Gramext.Sself; Gramext.Stoken ("", "."); Gramext.Stoken ("", "(");
        Gramext.Sself; Gramext.Stoken ("", ")")],
       Gramext.action
-        (fun _ (e2 : 'expr) _ _ (e1 : 'expr) (loc : int * int) ->
+        (fun _ (e2 : 'expr) _ _ (e1 : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("ExAre", [Qast.Loc; e1; e2]) : 'expr))];
      Some "~-", Some Gramext.NonA,
      [[Gramext.Stoken ("", "~-."); Gramext.Sself],
       Gramext.action
-        (fun (e : 'expr) _ (loc : int * int) ->
+        (fun (e : 'expr) _ (loc : Lexing.position * Lexing.position) ->
            (Qast.Node
               ("ExApp",
                [Qast.Loc; Qast.Node ("ExLid", [Qast.Loc; Qast.Str "~-."]);
@@ -1576,7 +1695,7 @@ Grammar.extend
             'expr));
       [Gramext.Stoken ("", "~-"); Gramext.Sself],
       Gramext.action
-        (fun (e : 'expr) _ (loc : int * int) ->
+        (fun (e : 'expr) _ (loc : Lexing.position * Lexing.position) ->
            (Qast.Node
               ("ExApp",
                [Qast.Loc; Qast.Node ("ExLid", [Qast.Loc; Qast.Str "~-"]);
@@ -1584,7 +1703,9 @@ Grammar.extend
             'expr))];
      Some "simple", None,
      [[Gramext.Stoken ("", "("); Gramext.Sself; Gramext.Stoken ("", ")")],
-      Gramext.action (fun _ (e : 'expr) _ (loc : int * int) -> (e : 'expr));
+      Gramext.action
+        (fun _ (e : 'expr) _ (loc : Lexing.position * Lexing.position) ->
+           (e : 'expr));
       [Gramext.Stoken ("", "("); Gramext.Sself; Gramext.Stoken ("", ",");
        Gramext.srules
          [[Gramext.Slist1sep
@@ -1592,25 +1713,28 @@ Grammar.extend
                 (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e)),
               Gramext.Stoken ("", ","))],
           Gramext.action
-            (fun (a : 'expr list) (loc : int * int) ->
+            (fun (a : 'expr list) (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))];
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))];
        Gramext.Stoken ("", ")")],
       Gramext.action
-        (fun _ (el : 'a_list) _ (e : 'expr) _ (loc : int * int) ->
+        (fun _ (el : 'a_list) _ (e : 'expr) _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("ExTup", [Qast.Loc; Qast.Cons (e, el)]) : 'expr));
       [Gramext.Stoken ("", "("); Gramext.Sself; Gramext.Stoken ("", ":");
        Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e));
        Gramext.Stoken ("", ")")],
       Gramext.action
-        (fun _ (t : 'ctyp) _ (e : 'expr) _ (loc : int * int) ->
+        (fun _ (t : 'ctyp) _ (e : 'expr) _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("ExTyc", [Qast.Loc; e; t]) : 'expr));
       [Gramext.Stoken ("", "("); Gramext.Stoken ("", ")")],
       Gramext.action
-        (fun _ _ (loc : int * int) ->
+        (fun _ _ (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("ExUid", [Qast.Loc; Qast.Str "()"]) : 'expr));
       [Gramext.Stoken ("", "{"); Gramext.Stoken ("", "("); Gramext.Sself;
        Gramext.Stoken ("", ")"); Gramext.Stoken ("", "with");
@@ -1621,15 +1745,18 @@ Grammar.extend
                    (label_expr : 'label_expr Grammar.Entry.e)),
               Gramext.Stoken ("", ";"))],
           Gramext.action
-            (fun (a : 'label_expr list) (loc : int * int) ->
+            (fun (a : 'label_expr list)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))];
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))];
        Gramext.Stoken ("", "}")],
       Gramext.action
-        (fun _ (lel : 'a_list) _ _ (e : 'expr) _ _ (loc : int * int) ->
+        (fun _ (lel : 'a_list) _ _ (e : 'expr) _ _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("ExRec", [Qast.Loc; lel; Qast.Option (Some e)]) :
             'expr));
       [Gramext.Stoken ("", "{");
@@ -1640,15 +1767,17 @@ Grammar.extend
                    (label_expr : 'label_expr Grammar.Entry.e)),
               Gramext.Stoken ("", ";"))],
           Gramext.action
-            (fun (a : 'label_expr list) (loc : int * int) ->
+            (fun (a : 'label_expr list)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))];
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))];
        Gramext.Stoken ("", "}")],
       Gramext.action
-        (fun _ (lel : 'a_list) _ (loc : int * int) ->
+        (fun _ (lel : 'a_list) _ (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("ExRec", [Qast.Loc; lel; Qast.Option None]) : 'expr));
       [Gramext.Stoken ("", "[|");
        Gramext.srules
@@ -1657,15 +1786,16 @@ Grammar.extend
                 (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e)),
               Gramext.Stoken ("", ";"))],
           Gramext.action
-            (fun (a : 'expr list) (loc : int * int) ->
+            (fun (a : 'expr list) (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))];
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))];
        Gramext.Stoken ("", "|]")],
       Gramext.action
-        (fun _ (el : 'a_list) _ (loc : int * int) ->
+        (fun _ (el : 'a_list) _ (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("ExArr", [Qast.Loc; el]) : 'expr));
       [Gramext.Stoken ("", "[");
        Gramext.srules
@@ -1674,69 +1804,94 @@ Grammar.extend
                 (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e)),
               Gramext.Stoken ("", ";"))],
           Gramext.action
-            (fun (a : 'expr list) (loc : int * int) ->
+            (fun (a : 'expr list) (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))];
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))];
        Gramext.Snterm
          (Grammar.Entry.obj (cons_expr_opt : 'cons_expr_opt Grammar.Entry.e));
        Gramext.Stoken ("", "]")],
       Gramext.action
-        (fun _ (last : 'cons_expr_opt) (el : 'a_list) _ (loc : int * int) ->
+        (fun _ (last : 'cons_expr_opt) (el : 'a_list) _
+           (loc : Lexing.position * Lexing.position) ->
            (mklistexp Qast.Loc last el : 'expr));
       [Gramext.Stoken ("", "["); Gramext.Stoken ("", "]")],
       Gramext.action
-        (fun _ _ (loc : int * int) ->
+        (fun _ _ (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("ExUid", [Qast.Loc; Qast.Str "[]"]) : 'expr));
       [Gramext.Snterm
          (Grammar.Entry.obj (expr_ident : 'expr_ident Grammar.Entry.e))],
-      Gramext.action (fun (i : 'expr_ident) (loc : int * int) -> (i : 'expr));
+      Gramext.action
+        (fun (i : 'expr_ident) (loc : Lexing.position * Lexing.position) ->
+           (i : 'expr));
       [Gramext.Snterm (Grammar.Entry.obj (a_CHAR : 'a_CHAR Grammar.Entry.e))],
       Gramext.action
-        (fun (s : 'a_CHAR) (loc : int * int) ->
+        (fun (s : 'a_CHAR) (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("ExChr", [Qast.Loc; s]) : 'expr));
       [Gramext.Snterm
          (Grammar.Entry.obj (a_STRING : 'a_STRING Grammar.Entry.e))],
       Gramext.action
-        (fun (s : 'a_STRING) (loc : int * int) ->
+        (fun (s : 'a_STRING) (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("ExStr", [Qast.Loc; s]) : 'expr));
       [Gramext.Snterm
          (Grammar.Entry.obj (a_FLOAT : 'a_FLOAT Grammar.Entry.e))],
       Gramext.action
-        (fun (s : 'a_FLOAT) (loc : int * int) ->
+        (fun (s : 'a_FLOAT) (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("ExFlo", [Qast.Loc; s]) : 'expr));
+      [Gramext.Snterm
+         (Grammar.Entry.obj (a_NATIVEINT : 'a_NATIVEINT Grammar.Entry.e))],
+      Gramext.action
+        (fun (s : 'a_NATIVEINT) (loc : Lexing.position * Lexing.position) ->
+           (Qast.Node ("ExNativeInt", [Qast.Loc; s]) : 'expr));
+      [Gramext.Snterm
+         (Grammar.Entry.obj (a_INT64 : 'a_INT64 Grammar.Entry.e))],
+      Gramext.action
+        (fun (s : 'a_INT64) (loc : Lexing.position * Lexing.position) ->
+           (Qast.Node ("ExInt64", [Qast.Loc; s]) : 'expr));
+      [Gramext.Snterm
+         (Grammar.Entry.obj (a_INT32 : 'a_INT32 Grammar.Entry.e))],
+      Gramext.action
+        (fun (s : 'a_INT32) (loc : Lexing.position * Lexing.position) ->
+           (Qast.Node ("ExInt32", [Qast.Loc; s]) : 'expr));
       [Gramext.Snterm (Grammar.Entry.obj (a_INT : 'a_INT Grammar.Entry.e))],
       Gramext.action
-        (fun (s : 'a_INT) (loc : int * int) ->
+        (fun (s : 'a_INT) (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("ExInt", [Qast.Loc; s]) : 'expr))]];
     Grammar.Entry.obj (cons_expr_opt : 'cons_expr_opt Grammar.Entry.e), None,
     [None, None,
      [[],
       Gramext.action
-        (fun (loc : int * int) -> (Qast.Option None : 'cons_expr_opt));
+        (fun (loc : Lexing.position * Lexing.position) ->
+           (Qast.Option None : 'cons_expr_opt));
       [Gramext.Stoken ("", "::");
        Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))],
       Gramext.action
-        (fun (e : 'expr) _ (loc : int * int) ->
+        (fun (e : 'expr) _ (loc : Lexing.position * Lexing.position) ->
            (Qast.Option (Some e) : 'cons_expr_opt))]];
     Grammar.Entry.obj (dummy : 'dummy Grammar.Entry.e), None,
     [None, None,
-     [[], Gramext.action (fun (loc : int * int) -> (() : 'dummy))]];
+     [[],
+      Gramext.action
+        (fun (loc : Lexing.position * Lexing.position) -> (() : 'dummy))]];
     Grammar.Entry.obj (sequence : 'sequence Grammar.Entry.e), None,
     [None, None,
      [[Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))],
       Gramext.action
-        (fun (e : 'expr) (loc : int * int) -> (Qast.List [e] : 'sequence));
+        (fun (e : 'expr) (loc : Lexing.position * Lexing.position) ->
+           (Qast.List [e] : 'sequence));
       [Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e));
        Gramext.Stoken ("", ";")],
       Gramext.action
-        (fun _ (e : 'expr) (loc : int * int) -> (Qast.List [e] : 'sequence));
+        (fun _ (e : 'expr) (loc : Lexing.position * Lexing.position) ->
+           (Qast.List [e] : 'sequence));
       [Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e));
        Gramext.Stoken ("", ";"); Gramext.Sself],
       Gramext.action
-        (fun (el : 'sequence) _ (e : 'expr) (loc : int * int) ->
+        (fun (el : 'sequence) _ (e : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Cons (e, el) : 'sequence));
       [Gramext.Stoken ("", "let");
        Gramext.srules
@@ -1744,15 +1899,18 @@ Grammar.extend
              (Gramext.srules
                 [[Gramext.Stoken ("", "rec")],
                  Gramext.action
-                   (fun (x : string) (loc : int * int) ->
+                   (fun (x : string)
+                      (loc : Lexing.position * Lexing.position) ->
                       (Qast.Str x : 'e__8))])],
           Gramext.action
-            (fun (a : 'e__8 option) (loc : int * int) ->
+            (fun (a : 'e__8 option)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.Option a : 'a_opt));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_opt) (loc : int * int) -> (a : 'a_opt))];
+            (fun (a : 'a_opt) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_opt))];
        Gramext.srules
          [[Gramext.Slist1sep
              (Gramext.Snterm
@@ -1760,21 +1918,27 @@ Grammar.extend
                    (let_binding : 'let_binding Grammar.Entry.e)),
               Gramext.Stoken ("", "and"))],
           Gramext.action
-            (fun (a : 'let_binding list) (loc : int * int) ->
+            (fun (a : 'let_binding list)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))];
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))];
        Gramext.srules
          [[Gramext.Stoken ("", ";")],
-          Gramext.action (fun (x : string) (loc : int * int) -> (x : 'e__9));
+          Gramext.action
+            (fun (x : string) (loc : Lexing.position * Lexing.position) ->
+               (x : 'e__9));
           [Gramext.Stoken ("", "in")],
-          Gramext.action (fun (x : string) (loc : int * int) -> (x : 'e__9))];
+          Gramext.action
+            (fun (x : string) (loc : Lexing.position * Lexing.position) ->
+               (x : 'e__9))];
        Gramext.Sself],
       Gramext.action
         (fun (el : 'sequence) _ (l : 'a_list) (rf : 'a_opt) _
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.List
               [Qast.Node
                  ("ExLet", [Qast.Loc; o2b rf; l; mksequence Qast.Loc el])] :
@@ -1785,7 +1949,8 @@ Grammar.extend
        Gramext.Snterm
          (Grammar.Entry.obj (fun_binding : 'fun_binding Grammar.Entry.e))],
       Gramext.action
-        (fun (e : 'fun_binding) (p : 'ipatt) (loc : int * int) ->
+        (fun (e : 'fun_binding) (p : 'ipatt)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Tuple [p; e] : 'let_binding))]];
     Grammar.Entry.obj (fun_binding : 'fun_binding Grammar.Entry.e), None,
     [None, Some Gramext.RightA,
@@ -1794,16 +1959,19 @@ Grammar.extend
        Gramext.Stoken ("", "=");
        Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))],
       Gramext.action
-        (fun (e : 'expr) _ (t : 'ctyp) _ (loc : int * int) ->
+        (fun (e : 'expr) _ (t : 'ctyp) _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("ExTyc", [Qast.Loc; e; t]) : 'fun_binding));
       [Gramext.Stoken ("", "=");
        Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))],
       Gramext.action
-        (fun (e : 'expr) _ (loc : int * int) -> (e : 'fun_binding));
+        (fun (e : 'expr) _ (loc : Lexing.position * Lexing.position) ->
+           (e : 'fun_binding));
       [Gramext.Snterm (Grammar.Entry.obj (ipatt : 'ipatt Grammar.Entry.e));
        Gramext.Sself],
       Gramext.action
-        (fun (e : 'fun_binding) (p : 'ipatt) (loc : int * int) ->
+        (fun (e : 'fun_binding) (p : 'ipatt)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node
               ("ExFun",
                [Qast.Loc; Qast.List [Qast.Tuple [p; Qast.Option None; e]]]) :
@@ -1819,27 +1987,29 @@ Grammar.extend
        Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))],
       Gramext.action
         (fun (e : 'expr) _ (w : 'when_expr_opt) (aso : 'as_patt_opt)
-           (p : 'patt) (loc : int * int) ->
+           (p : 'patt) (loc : Lexing.position * Lexing.position) ->
            (mkmatchcase Qast.Loc p aso w e : 'match_case))]];
     Grammar.Entry.obj (as_patt_opt : 'as_patt_opt Grammar.Entry.e), None,
     [None, None,
      [[],
       Gramext.action
-        (fun (loc : int * int) -> (Qast.Option None : 'as_patt_opt));
+        (fun (loc : Lexing.position * Lexing.position) ->
+           (Qast.Option None : 'as_patt_opt));
       [Gramext.Stoken ("", "as");
        Gramext.Snterm (Grammar.Entry.obj (patt : 'patt Grammar.Entry.e))],
       Gramext.action
-        (fun (p : 'patt) _ (loc : int * int) ->
+        (fun (p : 'patt) _ (loc : Lexing.position * Lexing.position) ->
            (Qast.Option (Some p) : 'as_patt_opt))]];
     Grammar.Entry.obj (when_expr_opt : 'when_expr_opt Grammar.Entry.e), None,
     [None, None,
      [[],
       Gramext.action
-        (fun (loc : int * int) -> (Qast.Option None : 'when_expr_opt));
+        (fun (loc : Lexing.position * Lexing.position) ->
+           (Qast.Option None : 'when_expr_opt));
       [Gramext.Stoken ("", "when");
        Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))],
       Gramext.action
-        (fun (e : 'expr) _ (loc : int * int) ->
+        (fun (e : 'expr) _ (loc : Lexing.position * Lexing.position) ->
            (Qast.Option (Some e) : 'when_expr_opt))]];
     Grammar.Entry.obj (label_expr : 'label_expr Grammar.Entry.e), None,
     [None, None,
@@ -1849,7 +2019,8 @@ Grammar.extend
        Gramext.Snterm
          (Grammar.Entry.obj (fun_binding : 'fun_binding Grammar.Entry.e))],
       Gramext.action
-        (fun (e : 'fun_binding) (i : 'patt_label_ident) (loc : int * int) ->
+        (fun (e : 'fun_binding) (i : 'patt_label_ident)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Tuple [i; e] : 'label_expr))]];
     Grammar.Entry.obj (expr_ident : 'expr_ident Grammar.Entry.e), None,
     [None, Some Gramext.RightA,
@@ -1857,27 +2028,31 @@ Grammar.extend
          (Grammar.Entry.obj (a_UIDENT : 'a_UIDENT Grammar.Entry.e));
        Gramext.Stoken ("", "."); Gramext.Sself],
       Gramext.action
-        (fun (j : 'expr_ident) _ (i : 'a_UIDENT) (loc : int * int) ->
+        (fun (j : 'expr_ident) _ (i : 'a_UIDENT)
+           (loc : Lexing.position * Lexing.position) ->
            (mkexprident Qast.Loc i j : 'expr_ident));
       [Gramext.Snterm
          (Grammar.Entry.obj (a_UIDENT : 'a_UIDENT Grammar.Entry.e))],
       Gramext.action
-        (fun (i : 'a_UIDENT) (loc : int * int) ->
+        (fun (i : 'a_UIDENT) (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("ExUid", [Qast.Loc; i]) : 'expr_ident));
       [Gramext.Snterm
          (Grammar.Entry.obj (a_LIDENT : 'a_LIDENT Grammar.Entry.e))],
       Gramext.action
-        (fun (i : 'a_LIDENT) (loc : int * int) ->
+        (fun (i : 'a_LIDENT) (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("ExLid", [Qast.Loc; i]) : 'expr_ident))]];
     Grammar.Entry.obj (fun_def : 'fun_def Grammar.Entry.e), None,
     [None, Some Gramext.RightA,
      [[Gramext.Stoken ("", "->");
        Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))],
-      Gramext.action (fun (e : 'expr) _ (loc : int * int) -> (e : 'fun_def));
+      Gramext.action
+        (fun (e : 'expr) _ (loc : Lexing.position * Lexing.position) ->
+           (e : 'fun_def));
       [Gramext.Snterm (Grammar.Entry.obj (ipatt : 'ipatt Grammar.Entry.e));
        Gramext.Sself],
       Gramext.action
-        (fun (e : 'fun_def) (p : 'ipatt) (loc : int * int) ->
+        (fun (e : 'fun_def) (p : 'ipatt)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node
               ("ExFun",
                [Qast.Loc; Qast.List [Qast.Tuple [p; Qast.Option None; e]]]) :
@@ -1886,27 +2061,31 @@ Grammar.extend
     [None, Some Gramext.LeftA,
      [[Gramext.Sself; Gramext.Stoken ("", "|"); Gramext.Sself],
       Gramext.action
-        (fun (p2 : 'patt) _ (p1 : 'patt) (loc : int * int) ->
+        (fun (p2 : 'patt) _ (p1 : 'patt)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("PaOrp", [Qast.Loc; p1; p2]) : 'patt))];
      None, Some Gramext.NonA,
      [[Gramext.Sself; Gramext.Stoken ("", ".."); Gramext.Sself],
       Gramext.action
-        (fun (p2 : 'patt) _ (p1 : 'patt) (loc : int * int) ->
+        (fun (p2 : 'patt) _ (p1 : 'patt)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("PaRng", [Qast.Loc; p1; p2]) : 'patt))];
      None, Some Gramext.LeftA,
      [[Gramext.Sself; Gramext.Sself],
       Gramext.action
-        (fun (p2 : 'patt) (p1 : 'patt) (loc : int * int) ->
+        (fun (p2 : 'patt) (p1 : 'patt)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("PaApp", [Qast.Loc; p1; p2]) : 'patt))];
      None, Some Gramext.LeftA,
      [[Gramext.Sself; Gramext.Stoken ("", "."); Gramext.Sself],
       Gramext.action
-        (fun (p2 : 'patt) _ (p1 : 'patt) (loc : int * int) ->
+        (fun (p2 : 'patt) _ (p1 : 'patt)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("PaAcc", [Qast.Loc; p1; p2]) : 'patt))];
      Some "simple", None,
      [[Gramext.Stoken ("", "_")],
       Gramext.action
-        (fun _ (loc : int * int) ->
+        (fun _ (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("PaAny", [Qast.Loc]) : 'patt));
       [Gramext.Stoken ("", "("); Gramext.Sself; Gramext.Stoken ("", ",");
        Gramext.srules
@@ -1915,32 +2094,38 @@ Grammar.extend
                 (Grammar.Entry.obj (patt : 'patt Grammar.Entry.e)),
               Gramext.Stoken ("", ","))],
           Gramext.action
-            (fun (a : 'patt list) (loc : int * int) ->
+            (fun (a : 'patt list) (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))];
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))];
        Gramext.Stoken ("", ")")],
       Gramext.action
-        (fun _ (pl : 'a_list) _ (p : 'patt) _ (loc : int * int) ->
+        (fun _ (pl : 'a_list) _ (p : 'patt) _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("PaTup", [Qast.Loc; Qast.Cons (p, pl)]) : 'patt));
       [Gramext.Stoken ("", "("); Gramext.Sself; Gramext.Stoken ("", "as");
        Gramext.Sself; Gramext.Stoken ("", ")")],
       Gramext.action
-        (fun _ (p2 : 'patt) _ (p : 'patt) _ (loc : int * int) ->
+        (fun _ (p2 : 'patt) _ (p : 'patt) _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("PaAli", [Qast.Loc; p; p2]) : 'patt));
       [Gramext.Stoken ("", "("); Gramext.Sself; Gramext.Stoken ("", ":");
        Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e));
        Gramext.Stoken ("", ")")],
       Gramext.action
-        (fun _ (t : 'ctyp) _ (p : 'patt) _ (loc : int * int) ->
+        (fun _ (t : 'ctyp) _ (p : 'patt) _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("PaTyc", [Qast.Loc; p; t]) : 'patt));
       [Gramext.Stoken ("", "("); Gramext.Sself; Gramext.Stoken ("", ")")],
-      Gramext.action (fun _ (p : 'patt) _ (loc : int * int) -> (p : 'patt));
+      Gramext.action
+        (fun _ (p : 'patt) _ (loc : Lexing.position * Lexing.position) ->
+           (p : 'patt));
       [Gramext.Stoken ("", "("); Gramext.Stoken ("", ")")],
       Gramext.action
-        (fun _ _ (loc : int * int) ->
+        (fun _ _ (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("PaUid", [Qast.Loc; Qast.Str "()"]) : 'patt));
       [Gramext.Stoken ("", "{");
        Gramext.srules
@@ -1950,15 +2135,17 @@ Grammar.extend
                    (label_patt : 'label_patt Grammar.Entry.e)),
               Gramext.Stoken ("", ";"))],
           Gramext.action
-            (fun (a : 'label_patt list) (loc : int * int) ->
+            (fun (a : 'label_patt list)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))];
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))];
        Gramext.Stoken ("", "}")],
       Gramext.action
-        (fun _ (lpl : 'a_list) _ (loc : int * int) ->
+        (fun _ (lpl : 'a_list) _ (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("PaRec", [Qast.Loc; lpl]) : 'patt));
       [Gramext.Stoken ("", "[|");
        Gramext.srules
@@ -1967,15 +2154,16 @@ Grammar.extend
                 (Grammar.Entry.obj (patt : 'patt Grammar.Entry.e)),
               Gramext.Stoken ("", ";"))],
           Gramext.action
-            (fun (a : 'patt list) (loc : int * int) ->
+            (fun (a : 'patt list) (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))];
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))];
        Gramext.Stoken ("", "|]")],
       Gramext.action
-        (fun _ (pl : 'a_list) _ (loc : int * int) ->
+        (fun _ (pl : 'a_list) _ (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("PaArr", [Qast.Loc; pl]) : 'patt));
       [Gramext.Stoken ("", "[");
        Gramext.srules
@@ -1984,70 +2172,106 @@ Grammar.extend
                 (Grammar.Entry.obj (patt : 'patt Grammar.Entry.e)),
               Gramext.Stoken ("", ";"))],
           Gramext.action
-            (fun (a : 'patt list) (loc : int * int) ->
+            (fun (a : 'patt list) (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))];
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))];
        Gramext.Snterm
          (Grammar.Entry.obj (cons_patt_opt : 'cons_patt_opt Grammar.Entry.e));
        Gramext.Stoken ("", "]")],
       Gramext.action
-        (fun _ (last : 'cons_patt_opt) (pl : 'a_list) _ (loc : int * int) ->
+        (fun _ (last : 'cons_patt_opt) (pl : 'a_list) _
+           (loc : Lexing.position * Lexing.position) ->
            (mklistpat Qast.Loc last pl : 'patt));
       [Gramext.Stoken ("", "["); Gramext.Stoken ("", "]")],
       Gramext.action
-        (fun _ _ (loc : int * int) ->
+        (fun _ _ (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("PaUid", [Qast.Loc; Qast.Str "[]"]) : 'patt));
       [Gramext.Stoken ("", "-");
        Gramext.Snterm
          (Grammar.Entry.obj (a_FLOAT : 'a_FLOAT Grammar.Entry.e))],
       Gramext.action
-        (fun (s : 'a_FLOAT) _ (loc : int * int) ->
+        (fun (s : 'a_FLOAT) _ (loc : Lexing.position * Lexing.position) ->
            (mkuminpat Qast.Loc (Qast.Str "-") (Qast.Bool false) s : 'patt));
       [Gramext.Stoken ("", "-");
+       Gramext.Snterm
+         (Grammar.Entry.obj (a_NATIVEINT : 'a_NATIVEINT Grammar.Entry.e))],
+      Gramext.action
+        (fun (s : 'a_NATIVEINT) _ (loc : Lexing.position * Lexing.position) ->
+           (mkuminpat Qast.Loc (Qast.Str "-") (Qast.Bool true) s : 'patt));
+      [Gramext.Stoken ("", "-");
+       Gramext.Snterm
+         (Grammar.Entry.obj (a_INT64 : 'a_INT64 Grammar.Entry.e))],
+      Gramext.action
+        (fun (s : 'a_INT64) _ (loc : Lexing.position * Lexing.position) ->
+           (mkuminpat Qast.Loc (Qast.Str "-") (Qast.Bool true) s : 'patt));
+      [Gramext.Stoken ("", "-");
+       Gramext.Snterm
+         (Grammar.Entry.obj (a_INT32 : 'a_INT32 Grammar.Entry.e))],
+      Gramext.action
+        (fun (s : 'a_INT32) _ (loc : Lexing.position * Lexing.position) ->
+           (mkuminpat Qast.Loc (Qast.Str "-") (Qast.Bool true) s : 'patt));
+      [Gramext.Stoken ("", "-");
        Gramext.Snterm (Grammar.Entry.obj (a_INT : 'a_INT Grammar.Entry.e))],
       Gramext.action
-        (fun (s : 'a_INT) _ (loc : int * int) ->
+        (fun (s : 'a_INT) _ (loc : Lexing.position * Lexing.position) ->
            (mkuminpat Qast.Loc (Qast.Str "-") (Qast.Bool true) s : 'patt));
       [Gramext.Snterm (Grammar.Entry.obj (a_CHAR : 'a_CHAR Grammar.Entry.e))],
       Gramext.action
-        (fun (s : 'a_CHAR) (loc : int * int) ->
+        (fun (s : 'a_CHAR) (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("PaChr", [Qast.Loc; s]) : 'patt));
       [Gramext.Snterm
          (Grammar.Entry.obj (a_STRING : 'a_STRING Grammar.Entry.e))],
       Gramext.action
-        (fun (s : 'a_STRING) (loc : int * int) ->
+        (fun (s : 'a_STRING) (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("PaStr", [Qast.Loc; s]) : 'patt));
       [Gramext.Snterm
          (Grammar.Entry.obj (a_FLOAT : 'a_FLOAT Grammar.Entry.e))],
       Gramext.action
-        (fun (s : 'a_FLOAT) (loc : int * int) ->
+        (fun (s : 'a_FLOAT) (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("PaFlo", [Qast.Loc; s]) : 'patt));
+      [Gramext.Snterm
+         (Grammar.Entry.obj (a_NATIVEINT : 'a_NATIVEINT Grammar.Entry.e))],
+      Gramext.action
+        (fun (s : 'a_NATIVEINT) (loc : Lexing.position * Lexing.position) ->
+           (Qast.Node ("PaNativeInt", [Qast.Loc; s]) : 'patt));
+      [Gramext.Snterm
+         (Grammar.Entry.obj (a_INT64 : 'a_INT64 Grammar.Entry.e))],
+      Gramext.action
+        (fun (s : 'a_INT64) (loc : Lexing.position * Lexing.position) ->
+           (Qast.Node ("PaInt64", [Qast.Loc; s]) : 'patt));
+      [Gramext.Snterm
+         (Grammar.Entry.obj (a_INT32 : 'a_INT32 Grammar.Entry.e))],
+      Gramext.action
+        (fun (s : 'a_INT32) (loc : Lexing.position * Lexing.position) ->
+           (Qast.Node ("PaInt32", [Qast.Loc; s]) : 'patt));
       [Gramext.Snterm (Grammar.Entry.obj (a_INT : 'a_INT Grammar.Entry.e))],
       Gramext.action
-        (fun (s : 'a_INT) (loc : int * int) ->
+        (fun (s : 'a_INT) (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("PaInt", [Qast.Loc; s]) : 'patt));
       [Gramext.Snterm
          (Grammar.Entry.obj (a_UIDENT : 'a_UIDENT Grammar.Entry.e))],
       Gramext.action
-        (fun (s : 'a_UIDENT) (loc : int * int) ->
+        (fun (s : 'a_UIDENT) (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("PaUid", [Qast.Loc; s]) : 'patt));
       [Gramext.Snterm
          (Grammar.Entry.obj (a_LIDENT : 'a_LIDENT Grammar.Entry.e))],
       Gramext.action
-        (fun (s : 'a_LIDENT) (loc : int * int) ->
+        (fun (s : 'a_LIDENT) (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("PaLid", [Qast.Loc; s]) : 'patt))]];
     Grammar.Entry.obj (cons_patt_opt : 'cons_patt_opt Grammar.Entry.e), None,
     [None, None,
      [[],
       Gramext.action
-        (fun (loc : int * int) -> (Qast.Option None : 'cons_patt_opt));
+        (fun (loc : Lexing.position * Lexing.position) ->
+           (Qast.Option None : 'cons_patt_opt));
       [Gramext.Stoken ("", "::");
        Gramext.Snterm (Grammar.Entry.obj (patt : 'patt Grammar.Entry.e))],
       Gramext.action
-        (fun (p : 'patt) _ (loc : int * int) ->
+        (fun (p : 'patt) _ (loc : Lexing.position * Lexing.position) ->
            (Qast.Option (Some p) : 'cons_patt_opt))]];
     Grammar.Entry.obj (label_patt : 'label_patt Grammar.Entry.e), None,
     [None, None,
@@ -2057,7 +2281,8 @@ Grammar.extend
        Gramext.Stoken ("", "=");
        Gramext.Snterm (Grammar.Entry.obj (patt : 'patt Grammar.Entry.e))],
       Gramext.action
-        (fun (p : 'patt) _ (i : 'patt_label_ident) (loc : int * int) ->
+        (fun (p : 'patt) _ (i : 'patt_label_ident)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Tuple [i; p] : 'label_patt))]];
     Grammar.Entry.obj (patt_label_ident : 'patt_label_ident Grammar.Entry.e),
     None,
@@ -2065,29 +2290,29 @@ Grammar.extend
      [[Gramext.Sself; Gramext.Stoken ("", "."); Gramext.Sself],
       Gramext.action
         (fun (p2 : 'patt_label_ident) _ (p1 : 'patt_label_ident)
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("PaAcc", [Qast.Loc; p1; p2]) : 'patt_label_ident))];
      Some "simple", Some Gramext.RightA,
      [[Gramext.Snterm
          (Grammar.Entry.obj (a_LIDENT : 'a_LIDENT Grammar.Entry.e))],
       Gramext.action
-        (fun (i : 'a_LIDENT) (loc : int * int) ->
+        (fun (i : 'a_LIDENT) (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("PaLid", [Qast.Loc; i]) : 'patt_label_ident));
       [Gramext.Snterm
          (Grammar.Entry.obj (a_UIDENT : 'a_UIDENT Grammar.Entry.e))],
       Gramext.action
-        (fun (i : 'a_UIDENT) (loc : int * int) ->
+        (fun (i : 'a_UIDENT) (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("PaUid", [Qast.Loc; i]) : 'patt_label_ident))]];
     Grammar.Entry.obj (ipatt : 'ipatt Grammar.Entry.e), None,
     [None, None,
      [[Gramext.Stoken ("", "_")],
       Gramext.action
-        (fun _ (loc : int * int) ->
+        (fun _ (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("PaAny", [Qast.Loc]) : 'ipatt));
       [Gramext.Snterm
          (Grammar.Entry.obj (a_LIDENT : 'a_LIDENT Grammar.Entry.e))],
       Gramext.action
-        (fun (s : 'a_LIDENT) (loc : int * int) ->
+        (fun (s : 'a_LIDENT) (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("PaLid", [Qast.Loc; s]) : 'ipatt));
       [Gramext.Stoken ("", "("); Gramext.Sself; Gramext.Stoken ("", ",");
        Gramext.srules
@@ -2096,32 +2321,39 @@ Grammar.extend
                 (Grammar.Entry.obj (ipatt : 'ipatt Grammar.Entry.e)),
               Gramext.Stoken ("", ","))],
           Gramext.action
-            (fun (a : 'ipatt list) (loc : int * int) ->
+            (fun (a : 'ipatt list)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))];
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))];
        Gramext.Stoken ("", ")")],
       Gramext.action
-        (fun _ (pl : 'a_list) _ (p : 'ipatt) _ (loc : int * int) ->
+        (fun _ (pl : 'a_list) _ (p : 'ipatt) _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("PaTup", [Qast.Loc; Qast.Cons (p, pl)]) : 'ipatt));
       [Gramext.Stoken ("", "("); Gramext.Sself; Gramext.Stoken ("", "as");
        Gramext.Sself; Gramext.Stoken ("", ")")],
       Gramext.action
-        (fun _ (p2 : 'ipatt) _ (p : 'ipatt) _ (loc : int * int) ->
+        (fun _ (p2 : 'ipatt) _ (p : 'ipatt) _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("PaAli", [Qast.Loc; p; p2]) : 'ipatt));
       [Gramext.Stoken ("", "("); Gramext.Sself; Gramext.Stoken ("", ":");
        Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e));
        Gramext.Stoken ("", ")")],
       Gramext.action
-        (fun _ (t : 'ctyp) _ (p : 'ipatt) _ (loc : int * int) ->
+        (fun _ (t : 'ctyp) _ (p : 'ipatt) _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("PaTyc", [Qast.Loc; p; t]) : 'ipatt));
       [Gramext.Stoken ("", "("); Gramext.Sself; Gramext.Stoken ("", ")")],
-      Gramext.action (fun _ (p : 'ipatt) _ (loc : int * int) -> (p : 'ipatt));
+      Gramext.action
+        (fun _ (p : 'ipatt) _ (loc : Lexing.position * Lexing.position) ->
+           (p : 'ipatt));
       [Gramext.Stoken ("", "("); Gramext.Stoken ("", ")")],
       Gramext.action
-        (fun _ _ (loc : int * int) ->
+        (fun _ _ (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("PaUid", [Qast.Loc; Qast.Str "()"]) : 'ipatt));
       [Gramext.Stoken ("", "{");
        Gramext.srules
@@ -2131,15 +2363,17 @@ Grammar.extend
                    (label_ipatt : 'label_ipatt Grammar.Entry.e)),
               Gramext.Stoken ("", ";"))],
           Gramext.action
-            (fun (a : 'label_ipatt list) (loc : int * int) ->
+            (fun (a : 'label_ipatt list)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))];
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))];
        Gramext.Stoken ("", "}")],
       Gramext.action
-        (fun _ (lpl : 'a_list) _ (loc : int * int) ->
+        (fun _ (lpl : 'a_list) _ (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("PaRec", [Qast.Loc; lpl]) : 'ipatt))]];
     Grammar.Entry.obj (label_ipatt : 'label_ipatt Grammar.Entry.e), None,
     [None, None,
@@ -2149,7 +2383,8 @@ Grammar.extend
        Gramext.Stoken ("", "=");
        Gramext.Snterm (Grammar.Entry.obj (ipatt : 'ipatt Grammar.Entry.e))],
       Gramext.action
-        (fun (p : 'ipatt) _ (i : 'patt_label_ident) (loc : int * int) ->
+        (fun (p : 'ipatt) _ (i : 'patt_label_ident)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Tuple [i; p] : 'label_ipatt))]];
     Grammar.Entry.obj (type_declaration : 'type_declaration Grammar.Entry.e),
     None,
@@ -2162,12 +2397,14 @@ Grammar.extend
                 (Grammar.Entry.obj
                    (type_parameter : 'type_parameter Grammar.Entry.e)))],
           Gramext.action
-            (fun (a : 'type_parameter list) (loc : int * int) ->
+            (fun (a : 'type_parameter list)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))];
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))];
        Gramext.Stoken ("", "=");
        Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e));
        Gramext.srules
@@ -2176,22 +2413,24 @@ Grammar.extend
                 (Grammar.Entry.obj
                    (constrain : 'constrain Grammar.Entry.e)))],
           Gramext.action
-            (fun (a : 'constrain list) (loc : int * int) ->
+            (fun (a : 'constrain list)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))]],
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))]],
       Gramext.action
         (fun (cl : 'a_list) (tk : 'ctyp) _ (tpl : 'a_list) (n : 'type_patt)
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Tuple [n; tpl; tk; cl] : 'type_declaration))]];
     Grammar.Entry.obj (type_patt : 'type_patt Grammar.Entry.e), None,
     [None, None,
      [[Gramext.Snterm
          (Grammar.Entry.obj (a_LIDENT : 'a_LIDENT Grammar.Entry.e))],
       Gramext.action
-        (fun (n : 'a_LIDENT) (loc : int * int) ->
+        (fun (n : 'a_LIDENT) (loc : Lexing.position * Lexing.position) ->
            (Qast.Tuple [Qast.Loc; n] : 'type_patt))]];
     Grammar.Entry.obj (constrain : 'constrain Grammar.Entry.e), None,
     [None, None,
@@ -2200,7 +2439,8 @@ Grammar.extend
        Gramext.Stoken ("", "=");
        Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))],
       Gramext.action
-        (fun (t2 : 'ctyp) _ (t1 : 'ctyp) _ (loc : int * int) ->
+        (fun (t2 : 'ctyp) _ (t1 : 'ctyp) _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Tuple [t1; t2] : 'constrain))]];
     Grammar.Entry.obj (type_parameter : 'type_parameter Grammar.Entry.e),
     None,
@@ -2208,31 +2448,33 @@ Grammar.extend
      [[Gramext.Stoken ("", "-"); Gramext.Stoken ("", "'");
        Gramext.Snterm (Grammar.Entry.obj (ident : 'ident Grammar.Entry.e))],
       Gramext.action
-        (fun (i : 'ident) _ _ (loc : int * int) ->
+        (fun (i : 'ident) _ _ (loc : Lexing.position * Lexing.position) ->
            (Qast.Tuple [i; Qast.Tuple [Qast.Bool false; Qast.Bool true]] :
             'type_parameter));
       [Gramext.Stoken ("", "+"); Gramext.Stoken ("", "'");
        Gramext.Snterm (Grammar.Entry.obj (ident : 'ident Grammar.Entry.e))],
       Gramext.action
-        (fun (i : 'ident) _ _ (loc : int * int) ->
+        (fun (i : 'ident) _ _ (loc : Lexing.position * Lexing.position) ->
            (Qast.Tuple [i; Qast.Tuple [Qast.Bool true; Qast.Bool false]] :
             'type_parameter));
       [Gramext.Stoken ("", "'");
        Gramext.Snterm (Grammar.Entry.obj (ident : 'ident Grammar.Entry.e))],
       Gramext.action
-        (fun (i : 'ident) _ (loc : int * int) ->
+        (fun (i : 'ident) _ (loc : Lexing.position * Lexing.position) ->
            (Qast.Tuple [i; Qast.Tuple [Qast.Bool false; Qast.Bool false]] :
             'type_parameter))]];
     Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e), None,
     [None, Some Gramext.LeftA,
      [[Gramext.Sself; Gramext.Stoken ("", "=="); Gramext.Sself],
       Gramext.action
-        (fun (t2 : 'ctyp) _ (t1 : 'ctyp) (loc : int * int) ->
+        (fun (t2 : 'ctyp) _ (t1 : 'ctyp)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("TyMan", [Qast.Loc; t1; t2]) : 'ctyp))];
      None, Some Gramext.LeftA,
      [[Gramext.Sself; Gramext.Stoken ("", "as"); Gramext.Sself],
       Gramext.action
-        (fun (t2 : 'ctyp) _ (t1 : 'ctyp) (loc : int * int) ->
+        (fun (t2 : 'ctyp) _ (t1 : 'ctyp)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("TyAli", [Qast.Loc; t1; t2]) : 'ctyp))];
      None, Some Gramext.LeftA,
      [[Gramext.Stoken ("", "!");
@@ -2241,56 +2483,66 @@ Grammar.extend
              (Gramext.Snterm
                 (Grammar.Entry.obj (typevar : 'typevar Grammar.Entry.e)))],
           Gramext.action
-            (fun (a : 'typevar list) (loc : int * int) ->
+            (fun (a : 'typevar list)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))];
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))];
        Gramext.Stoken ("", "."); Gramext.Sself],
       Gramext.action
-        (fun (t : 'ctyp) _ (pl : 'a_list) _ (loc : int * int) ->
+        (fun (t : 'ctyp) _ (pl : 'a_list) _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("TyPol", [Qast.Loc; pl; t]) : 'ctyp))];
      Some "arrow", Some Gramext.RightA,
      [[Gramext.Sself; Gramext.Stoken ("", "->"); Gramext.Sself],
       Gramext.action
-        (fun (t2 : 'ctyp) _ (t1 : 'ctyp) (loc : int * int) ->
+        (fun (t2 : 'ctyp) _ (t1 : 'ctyp)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("TyArr", [Qast.Loc; t1; t2]) : 'ctyp))];
      Some "label", Some Gramext.NonA,
      [[Gramext.Snterm
          (Grammar.Entry.obj (a_OPTLABEL : 'a_OPTLABEL Grammar.Entry.e));
        Gramext.Sself],
       Gramext.action
-        (fun (t : 'ctyp) (i : 'a_OPTLABEL) (loc : int * int) ->
+        (fun (t : 'ctyp) (i : 'a_OPTLABEL)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("TyOlb", [Qast.Loc; i; t]) : 'ctyp));
       [Gramext.Snterm
          (Grammar.Entry.obj
             (a_QUESTIONIDENT : 'a_QUESTIONIDENT Grammar.Entry.e));
        Gramext.Stoken ("", ":"); Gramext.Sself],
       Gramext.action
-        (fun (t : 'ctyp) _ (i : 'a_QUESTIONIDENT) (loc : int * int) ->
+        (fun (t : 'ctyp) _ (i : 'a_QUESTIONIDENT)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("TyOlb", [Qast.Loc; i; t]) : 'ctyp));
       [Gramext.Snterm
          (Grammar.Entry.obj (a_LABEL : 'a_LABEL Grammar.Entry.e));
        Gramext.Sself],
       Gramext.action
-        (fun (t : 'ctyp) (i : 'a_LABEL) (loc : int * int) ->
+        (fun (t : 'ctyp) (i : 'a_LABEL)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("TyLab", [Qast.Loc; i; t]) : 'ctyp));
       [Gramext.Snterm
          (Grammar.Entry.obj (a_TILDEIDENT : 'a_TILDEIDENT Grammar.Entry.e));
        Gramext.Stoken ("", ":"); Gramext.Sself],
       Gramext.action
-        (fun (t : 'ctyp) _ (i : 'a_TILDEIDENT) (loc : int * int) ->
+        (fun (t : 'ctyp) _ (i : 'a_TILDEIDENT)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("TyLab", [Qast.Loc; i; t]) : 'ctyp))];
      None, Some Gramext.LeftA,
      [[Gramext.Sself; Gramext.Sself],
       Gramext.action
-        (fun (t2 : 'ctyp) (t1 : 'ctyp) (loc : int * int) ->
+        (fun (t2 : 'ctyp) (t1 : 'ctyp)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("TyApp", [Qast.Loc; t1; t2]) : 'ctyp))];
      None, Some Gramext.LeftA,
      [[Gramext.Sself; Gramext.Stoken ("", "."); Gramext.Sself],
       Gramext.action
-        (fun (t2 : 'ctyp) _ (t1 : 'ctyp) (loc : int * int) ->
+        (fun (t2 : 'ctyp) _ (t1 : 'ctyp)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("TyAcc", [Qast.Loc; t1; t2]) : 'ctyp))];
      Some "simple", None,
      [[Gramext.Stoken ("", "{");
@@ -2301,15 +2553,17 @@ Grammar.extend
                    (label_declaration : 'label_declaration Grammar.Entry.e)),
               Gramext.Stoken ("", ";"))],
           Gramext.action
-            (fun (a : 'label_declaration list) (loc : int * int) ->
+            (fun (a : 'label_declaration list)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))];
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))];
        Gramext.Stoken ("", "}")],
       Gramext.action
-        (fun _ (ldl : 'a_list) _ (loc : int * int) ->
+        (fun _ (ldl : 'a_list) _ (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("TyRec", [Qast.Loc; Qast.Bool false; ldl]) : 'ctyp));
       [Gramext.Stoken ("", "[");
        Gramext.srules
@@ -2320,15 +2574,17 @@ Grammar.extend
                     'constructor_declaration Grammar.Entry.e)),
               Gramext.Stoken ("", "|"))],
           Gramext.action
-            (fun (a : 'constructor_declaration list) (loc : int * int) ->
+            (fun (a : 'constructor_declaration list)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))];
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))];
        Gramext.Stoken ("", "]")],
       Gramext.action
-        (fun _ (cdl : 'a_list) _ (loc : int * int) ->
+        (fun _ (cdl : 'a_list) _ (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("TySum", [Qast.Loc; Qast.Bool false; cdl]) : 'ctyp));
       [Gramext.Stoken ("", "private"); Gramext.Stoken ("", "{");
        Gramext.srules
@@ -2338,15 +2594,18 @@ Grammar.extend
                    (label_declaration : 'label_declaration Grammar.Entry.e)),
               Gramext.Stoken ("", ";"))],
           Gramext.action
-            (fun (a : 'label_declaration list) (loc : int * int) ->
+            (fun (a : 'label_declaration list)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))];
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))];
        Gramext.Stoken ("", "}")],
       Gramext.action
-        (fun _ (ldl : 'a_list) _ _ (loc : int * int) ->
+        (fun _ (ldl : 'a_list) _ _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("TyRec", [Qast.Loc; Qast.Bool true; ldl]) : 'ctyp));
       [Gramext.Stoken ("", "private"); Gramext.Stoken ("", "[");
        Gramext.srules
@@ -2357,18 +2616,23 @@ Grammar.extend
                     'constructor_declaration Grammar.Entry.e)),
               Gramext.Stoken ("", "|"))],
           Gramext.action
-            (fun (a : 'constructor_declaration list) (loc : int * int) ->
+            (fun (a : 'constructor_declaration list)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))];
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))];
        Gramext.Stoken ("", "]")],
       Gramext.action
-        (fun _ (cdl : 'a_list) _ _ (loc : int * int) ->
+        (fun _ (cdl : 'a_list) _ _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("TySum", [Qast.Loc; Qast.Bool true; cdl]) : 'ctyp));
       [Gramext.Stoken ("", "("); Gramext.Sself; Gramext.Stoken ("", ")")],
-      Gramext.action (fun _ (t : 'ctyp) _ (loc : int * int) -> (t : 'ctyp));
+      Gramext.action
+        (fun _ (t : 'ctyp) _ (loc : Lexing.position * Lexing.position) ->
+           (t : 'ctyp));
       [Gramext.Stoken ("", "("); Gramext.Sself; Gramext.Stoken ("", "*");
        Gramext.srules
          [[Gramext.Slist1sep
@@ -2376,34 +2640,36 @@ Grammar.extend
                 (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e)),
               Gramext.Stoken ("", "*"))],
           Gramext.action
-            (fun (a : 'ctyp list) (loc : int * int) ->
+            (fun (a : 'ctyp list) (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))];
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))];
        Gramext.Stoken ("", ")")],
       Gramext.action
-        (fun _ (tl : 'a_list) _ (t : 'ctyp) _ (loc : int * int) ->
+        (fun _ (tl : 'a_list) _ (t : 'ctyp) _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("TyTup", [Qast.Loc; Qast.Cons (t, tl)]) : 'ctyp));
       [Gramext.Snterm
          (Grammar.Entry.obj (a_UIDENT : 'a_UIDENT Grammar.Entry.e))],
       Gramext.action
-        (fun (i : 'a_UIDENT) (loc : int * int) ->
+        (fun (i : 'a_UIDENT) (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("TyUid", [Qast.Loc; i]) : 'ctyp));
       [Gramext.Snterm
          (Grammar.Entry.obj (a_LIDENT : 'a_LIDENT Grammar.Entry.e))],
       Gramext.action
-        (fun (i : 'a_LIDENT) (loc : int * int) ->
+        (fun (i : 'a_LIDENT) (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("TyLid", [Qast.Loc; i]) : 'ctyp));
       [Gramext.Stoken ("", "_")],
       Gramext.action
-        (fun _ (loc : int * int) ->
+        (fun _ (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("TyAny", [Qast.Loc]) : 'ctyp));
       [Gramext.Stoken ("", "'");
        Gramext.Snterm (Grammar.Entry.obj (ident : 'ident Grammar.Entry.e))],
       Gramext.action
-        (fun (i : 'ident) _ (loc : int * int) ->
+        (fun (i : 'ident) _ (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("TyQuo", [Qast.Loc; i]) : 'ctyp))]];
     Grammar.Entry.obj
       (constructor_declaration : 'constructor_declaration Grammar.Entry.e),
@@ -2412,7 +2678,7 @@ Grammar.extend
      [[Gramext.Snterm
          (Grammar.Entry.obj (a_UIDENT : 'a_UIDENT Grammar.Entry.e))],
       Gramext.action
-        (fun (ci : 'a_UIDENT) (loc : int * int) ->
+        (fun (ci : 'a_UIDENT) (loc : Lexing.position * Lexing.position) ->
            (Qast.Tuple [Qast.Loc; ci; Qast.List []] :
             'constructor_declaration));
       [Gramext.Snterm
@@ -2424,14 +2690,16 @@ Grammar.extend
                 (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e)),
               Gramext.Stoken ("", "and"))],
           Gramext.action
-            (fun (a : 'ctyp list) (loc : int * int) ->
+            (fun (a : 'ctyp list) (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))]],
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))]],
       Gramext.action
-        (fun (cal : 'a_list) _ (ci : 'a_UIDENT) (loc : int * int) ->
+        (fun (cal : 'a_list) _ (ci : 'a_UIDENT)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Tuple [Qast.Loc; ci; cal] : 'constructor_declaration))]];
     Grammar.Entry.obj
       (label_declaration : 'label_declaration Grammar.Entry.e),
@@ -2445,45 +2713,53 @@ Grammar.extend
              (Gramext.srules
                 [[Gramext.Stoken ("", "mutable")],
                  Gramext.action
-                   (fun (x : string) (loc : int * int) ->
+                   (fun (x : string)
+                      (loc : Lexing.position * Lexing.position) ->
                       (Qast.Str x : 'e__10))])],
           Gramext.action
-            (fun (a : 'e__10 option) (loc : int * int) ->
+            (fun (a : 'e__10 option)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.Option a : 'a_opt));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_opt) (loc : int * int) -> (a : 'a_opt))];
+            (fun (a : 'a_opt) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_opt))];
        Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))],
       Gramext.action
-        (fun (t : 'ctyp) (mf : 'a_opt) _ (i : 'a_LIDENT) (loc : int * int) ->
+        (fun (t : 'ctyp) (mf : 'a_opt) _ (i : 'a_LIDENT)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Tuple [Qast.Loc; i; o2b mf; t] : 'label_declaration))]];
     Grammar.Entry.obj (ident : 'ident Grammar.Entry.e), None,
     [None, None,
      [[Gramext.Snterm
          (Grammar.Entry.obj (a_UIDENT : 'a_UIDENT Grammar.Entry.e))],
-      Gramext.action (fun (i : 'a_UIDENT) (loc : int * int) -> (i : 'ident));
+      Gramext.action
+        (fun (i : 'a_UIDENT) (loc : Lexing.position * Lexing.position) ->
+           (i : 'ident));
       [Gramext.Snterm
          (Grammar.Entry.obj (a_LIDENT : 'a_LIDENT Grammar.Entry.e))],
       Gramext.action
-        (fun (i : 'a_LIDENT) (loc : int * int) -> (i : 'ident))]];
+        (fun (i : 'a_LIDENT) (loc : Lexing.position * Lexing.position) ->
+           (i : 'ident))]];
     Grammar.Entry.obj (mod_ident : 'mod_ident Grammar.Entry.e), None,
     [None, Some Gramext.RightA,
      [[Gramext.Snterm
          (Grammar.Entry.obj (a_UIDENT : 'a_UIDENT Grammar.Entry.e));
        Gramext.Stoken ("", "."); Gramext.Sself],
       Gramext.action
-        (fun (j : 'mod_ident) _ (i : 'a_UIDENT) (loc : int * int) ->
+        (fun (j : 'mod_ident) _ (i : 'a_UIDENT)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Cons (i, j) : 'mod_ident));
       [Gramext.Snterm
          (Grammar.Entry.obj (a_LIDENT : 'a_LIDENT Grammar.Entry.e))],
       Gramext.action
-        (fun (i : 'a_LIDENT) (loc : int * int) ->
+        (fun (i : 'a_LIDENT) (loc : Lexing.position * Lexing.position) ->
            (Qast.List [i] : 'mod_ident));
       [Gramext.Snterm
          (Grammar.Entry.obj (a_UIDENT : 'a_UIDENT Grammar.Entry.e))],
       Gramext.action
-        (fun (i : 'a_UIDENT) (loc : int * int) ->
+        (fun (i : 'a_UIDENT) (loc : Lexing.position * Lexing.position) ->
            (Qast.List [i] : 'mod_ident))]];
     Grammar.Entry.obj (str_item : 'str_item Grammar.Entry.e), None,
     [None, None,
@@ -2496,14 +2772,16 @@ Grammar.extend
                     'class_type_declaration Grammar.Entry.e)),
               Gramext.Stoken ("", "and"))],
           Gramext.action
-            (fun (a : 'class_type_declaration list) (loc : int * int) ->
+            (fun (a : 'class_type_declaration list)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))]],
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))]],
       Gramext.action
-        (fun (ctd : 'a_list) _ _ (loc : int * int) ->
+        (fun (ctd : 'a_list) _ _ (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("StClt", [Qast.Loc; ctd]) : 'str_item));
       [Gramext.Stoken ("", "class");
        Gramext.srules
@@ -2513,14 +2791,16 @@ Grammar.extend
                    (class_declaration : 'class_declaration Grammar.Entry.e)),
               Gramext.Stoken ("", "and"))],
           Gramext.action
-            (fun (a : 'class_declaration list) (loc : int * int) ->
+            (fun (a : 'class_declaration list)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))]],
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))]],
       Gramext.action
-        (fun (cd : 'a_list) _ (loc : int * int) ->
+        (fun (cd : 'a_list) _ (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("StCls", [Qast.Loc; cd]) : 'str_item))]];
     Grammar.Entry.obj (sig_item : 'sig_item Grammar.Entry.e), None,
     [None, None,
@@ -2533,14 +2813,16 @@ Grammar.extend
                     'class_type_declaration Grammar.Entry.e)),
               Gramext.Stoken ("", "and"))],
           Gramext.action
-            (fun (a : 'class_type_declaration list) (loc : int * int) ->
+            (fun (a : 'class_type_declaration list)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))]],
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))]],
       Gramext.action
-        (fun (ctd : 'a_list) _ _ (loc : int * int) ->
+        (fun (ctd : 'a_list) _ _ (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("SgClt", [Qast.Loc; ctd]) : 'sig_item));
       [Gramext.Stoken ("", "class");
        Gramext.srules
@@ -2550,14 +2832,16 @@ Grammar.extend
                    (class_description : 'class_description Grammar.Entry.e)),
               Gramext.Stoken ("", "and"))],
           Gramext.action
-            (fun (a : 'class_description list) (loc : int * int) ->
+            (fun (a : 'class_description list)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))]],
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))]],
       Gramext.action
-        (fun (cd : 'a_list) _ (loc : int * int) ->
+        (fun (cd : 'a_list) _ (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("SgCls", [Qast.Loc; cd]) : 'sig_item))]];
     Grammar.Entry.obj
       (class_declaration : 'class_declaration Grammar.Entry.e),
@@ -2568,15 +2852,18 @@ Grammar.extend
              (Gramext.srules
                 [[Gramext.Stoken ("", "virtual")],
                  Gramext.action
-                   (fun (x : string) (loc : int * int) ->
+                   (fun (x : string)
+                      (loc : Lexing.position * Lexing.position) ->
                       (Qast.Str x : 'e__11))])],
           Gramext.action
-            (fun (a : 'e__11 option) (loc : int * int) ->
+            (fun (a : 'e__11 option)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.Option a : 'a_opt));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_opt) (loc : int * int) -> (a : 'a_opt))];
+            (fun (a : 'a_opt) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_opt))];
        Gramext.Snterm
          (Grammar.Entry.obj (a_LIDENT : 'a_LIDENT Grammar.Entry.e));
        Gramext.Snterm
@@ -2587,7 +2874,8 @@ Grammar.extend
             (class_fun_binding : 'class_fun_binding Grammar.Entry.e))],
       Gramext.action
         (fun (cfb : 'class_fun_binding) (ctp : 'class_type_parameters)
-           (i : 'a_LIDENT) (vf : 'a_opt) (loc : int * int) ->
+           (i : 'a_LIDENT) (vf : 'a_opt)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Record
               ["ciLoc", Qast.Loc; "ciVir", o2b vf; "ciPrm", ctp; "ciNam", i;
                "ciExp", cfb] :
@@ -2599,7 +2887,8 @@ Grammar.extend
      [[Gramext.Snterm (Grammar.Entry.obj (ipatt : 'ipatt Grammar.Entry.e));
        Gramext.Sself],
       Gramext.action
-        (fun (cfb : 'class_fun_binding) (p : 'ipatt) (loc : int * int) ->
+        (fun (cfb : 'class_fun_binding) (p : 'ipatt)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("CeFun", [Qast.Loc; p; cfb]) : 'class_fun_binding));
       [Gramext.Stoken ("", ":");
        Gramext.Snterm
@@ -2608,13 +2897,14 @@ Grammar.extend
        Gramext.Snterm
          (Grammar.Entry.obj (class_expr : 'class_expr Grammar.Entry.e))],
       Gramext.action
-        (fun (ce : 'class_expr) _ (ct : 'class_type) _ (loc : int * int) ->
+        (fun (ce : 'class_expr) _ (ct : 'class_type) _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("CeTyc", [Qast.Loc; ce; ct]) : 'class_fun_binding));
       [Gramext.Stoken ("", "=");
        Gramext.Snterm
          (Grammar.Entry.obj (class_expr : 'class_expr Grammar.Entry.e))],
       Gramext.action
-        (fun (ce : 'class_expr) _ (loc : int * int) ->
+        (fun (ce : 'class_expr) _ (loc : Lexing.position * Lexing.position) ->
            (ce : 'class_fun_binding))]];
     Grammar.Entry.obj
       (class_type_parameters : 'class_type_parameters Grammar.Entry.e),
@@ -2628,19 +2918,21 @@ Grammar.extend
                    (type_parameter : 'type_parameter Grammar.Entry.e)),
               Gramext.Stoken ("", ","))],
           Gramext.action
-            (fun (a : 'type_parameter list) (loc : int * int) ->
+            (fun (a : 'type_parameter list)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))];
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))];
        Gramext.Stoken ("", "]")],
       Gramext.action
-        (fun _ (tpl : 'a_list) _ (loc : int * int) ->
+        (fun _ (tpl : 'a_list) _ (loc : Lexing.position * Lexing.position) ->
            (Qast.Tuple [Qast.Loc; tpl] : 'class_type_parameters));
       [],
       Gramext.action
-        (fun (loc : int * int) ->
+        (fun (loc : Lexing.position * Lexing.position) ->
            (Qast.Tuple [Qast.Loc; Qast.List []] : 'class_type_parameters))]];
     Grammar.Entry.obj (class_fun_def : 'class_fun_def Grammar.Entry.e), None,
     [None, None,
@@ -2648,11 +2940,13 @@ Grammar.extend
        Gramext.Snterm
          (Grammar.Entry.obj (class_expr : 'class_expr Grammar.Entry.e))],
       Gramext.action
-        (fun (ce : 'class_expr) _ (loc : int * int) -> (ce : 'class_fun_def));
+        (fun (ce : 'class_expr) _ (loc : Lexing.position * Lexing.position) ->
+           (ce : 'class_fun_def));
       [Gramext.Snterm (Grammar.Entry.obj (ipatt : 'ipatt Grammar.Entry.e));
        Gramext.Sself],
       Gramext.action
-        (fun (ce : 'class_fun_def) (p : 'ipatt) (loc : int * int) ->
+        (fun (ce : 'class_fun_def) (p : 'ipatt)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("CeFun", [Qast.Loc; p; ce]) : 'class_fun_def))]];
     Grammar.Entry.obj (class_expr : 'class_expr Grammar.Entry.e), None,
     [Some "top", None,
@@ -2662,15 +2956,18 @@ Grammar.extend
              (Gramext.srules
                 [[Gramext.Stoken ("", "rec")],
                  Gramext.action
-                   (fun (x : string) (loc : int * int) ->
+                   (fun (x : string)
+                      (loc : Lexing.position * Lexing.position) ->
                       (Qast.Str x : 'e__12))])],
           Gramext.action
-            (fun (a : 'e__12 option) (loc : int * int) ->
+            (fun (a : 'e__12 option)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.Option a : 'a_opt));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_opt) (loc : int * int) -> (a : 'a_opt))];
+            (fun (a : 'a_opt) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_opt))];
        Gramext.srules
          [[Gramext.Slist1sep
              (Gramext.Snterm
@@ -2678,16 +2975,18 @@ Grammar.extend
                    (let_binding : 'let_binding Grammar.Entry.e)),
               Gramext.Stoken ("", "and"))],
           Gramext.action
-            (fun (a : 'let_binding list) (loc : int * int) ->
+            (fun (a : 'let_binding list)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))];
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))];
        Gramext.Stoken ("", "in"); Gramext.Sself],
       Gramext.action
         (fun (ce : 'class_expr) _ (lb : 'a_list) (rf : 'a_opt) _
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("CeLet", [Qast.Loc; o2b rf; lb; ce]) : 'class_expr));
       [Gramext.Stoken ("", "fun");
        Gramext.Snterm (Grammar.Entry.obj (ipatt : 'ipatt Grammar.Entry.e));
@@ -2695,25 +2994,30 @@ Grammar.extend
          (Grammar.Entry.obj
             (class_fun_def : 'class_fun_def Grammar.Entry.e))],
       Gramext.action
-        (fun (ce : 'class_fun_def) (p : 'ipatt) _ (loc : int * int) ->
+        (fun (ce : 'class_fun_def) (p : 'ipatt) _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("CeFun", [Qast.Loc; p; ce]) : 'class_expr))];
      Some "apply", Some Gramext.NonA,
      [[Gramext.Sself;
        Gramext.Snterml
          (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e), "label")],
       Gramext.action
-        (fun (e : 'expr) (ce : 'class_expr) (loc : int * int) ->
+        (fun (e : 'expr) (ce : 'class_expr)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("CeApp", [Qast.Loc; ce; e]) : 'class_expr))];
      Some "simple", None,
      [[Gramext.Stoken ("", "("); Gramext.Sself; Gramext.Stoken ("", ")")],
       Gramext.action
-        (fun _ (ce : 'class_expr) _ (loc : int * int) -> (ce : 'class_expr));
+        (fun _ (ce : 'class_expr) _
+           (loc : Lexing.position * Lexing.position) ->
+           (ce : 'class_expr));
       [Gramext.Stoken ("", "("); Gramext.Sself; Gramext.Stoken ("", ":");
        Gramext.Snterm
          (Grammar.Entry.obj (class_type : 'class_type Grammar.Entry.e));
        Gramext.Stoken ("", ")")],
       Gramext.action
-        (fun _ (ct : 'class_type) _ (ce : 'class_expr) _ (loc : int * int) ->
+        (fun _ (ct : 'class_type) _ (ce : 'class_expr) _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("CeTyc", [Qast.Loc; ce; ct]) : 'class_expr));
       [Gramext.Stoken ("", "object");
        Gramext.srules
@@ -2722,24 +3026,28 @@ Grammar.extend
                 (Grammar.Entry.obj
                    (class_self_patt : 'class_self_patt Grammar.Entry.e)))],
           Gramext.action
-            (fun (a : 'class_self_patt option) (loc : int * int) ->
+            (fun (a : 'class_self_patt option)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.Option a : 'a_opt));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_opt) (loc : int * int) -> (a : 'a_opt))];
+            (fun (a : 'a_opt) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_opt))];
        Gramext.Snterm
          (Grammar.Entry.obj
             (class_structure : 'class_structure Grammar.Entry.e));
        Gramext.Stoken ("", "end")],
       Gramext.action
-        (fun _ (cf : 'class_structure) (cspo : 'a_opt) _ (loc : int * int) ->
+        (fun _ (cf : 'class_structure) (cspo : 'a_opt) _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("CeStr", [Qast.Loc; cspo; cf]) : 'class_expr));
       [Gramext.Snterm
          (Grammar.Entry.obj
             (class_longident : 'class_longident Grammar.Entry.e))],
       Gramext.action
-        (fun (ci : 'class_longident) (loc : int * int) ->
+        (fun (ci : 'class_longident)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("CeCon", [Qast.Loc; ci; Qast.List []]) : 'class_expr));
       [Gramext.Snterm
          (Grammar.Entry.obj
@@ -2751,15 +3059,17 @@ Grammar.extend
                 (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e)),
               Gramext.Stoken ("", ","))],
           Gramext.action
-            (fun (a : 'ctyp list) (loc : int * int) ->
+            (fun (a : 'ctyp list) (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))];
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))];
        Gramext.Stoken ("", "]")],
       Gramext.action
-        (fun _ (ctcl : 'a_list) _ (ci : 'class_longident) (loc : int * int) ->
+        (fun _ (ctcl : 'a_list) _ (ci : 'class_longident)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("CeCon", [Qast.Loc; ci; ctcl]) : 'class_expr))]];
     Grammar.Entry.obj (class_structure : 'class_structure Grammar.Entry.e),
     None,
@@ -2772,17 +3082,21 @@ Grammar.extend
                        (class_str_item : 'class_str_item Grammar.Entry.e));
                   Gramext.Stoken ("", ";")],
                  Gramext.action
-                   (fun _ (cf : 'class_str_item) (loc : int * int) ->
+                   (fun _ (cf : 'class_str_item)
+                      (loc : Lexing.position * Lexing.position) ->
                       (cf : 'e__13))])],
           Gramext.action
-            (fun (a : 'e__13 list) (loc : int * int) ->
+            (fun (a : 'e__13 list)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))]],
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))]],
       Gramext.action
-        (fun (cf : 'a_list) (loc : int * int) -> (cf : 'class_structure))]];
+        (fun (cf : 'a_list) (loc : Lexing.position * Lexing.position) ->
+           (cf : 'class_structure))]];
     Grammar.Entry.obj (class_self_patt : 'class_self_patt Grammar.Entry.e),
     None,
     [None, None,
@@ -2792,27 +3106,30 @@ Grammar.extend
        Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e));
        Gramext.Stoken ("", ")")],
       Gramext.action
-        (fun _ (t : 'ctyp) _ (p : 'patt) _ (loc : int * int) ->
+        (fun _ (t : 'ctyp) _ (p : 'patt) _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("PaTyc", [Qast.Loc; p; t]) : 'class_self_patt));
       [Gramext.Stoken ("", "(");
        Gramext.Snterm (Grammar.Entry.obj (patt : 'patt Grammar.Entry.e));
        Gramext.Stoken ("", ")")],
       Gramext.action
-        (fun _ (p : 'patt) _ (loc : int * int) -> (p : 'class_self_patt))]];
+        (fun _ (p : 'patt) _ (loc : Lexing.position * Lexing.position) ->
+           (p : 'class_self_patt))]];
     Grammar.Entry.obj (class_str_item : 'class_str_item Grammar.Entry.e),
     None,
     [None, None,
      [[Gramext.Stoken ("", "initializer");
        Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))],
       Gramext.action
-        (fun (se : 'expr) _ (loc : int * int) ->
+        (fun (se : 'expr) _ (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("CrIni", [Qast.Loc; se]) : 'class_str_item));
       [Gramext.Stoken ("", "type");
        Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e));
        Gramext.Stoken ("", "=");
        Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))],
       Gramext.action
-        (fun (t2 : 'ctyp) _ (t1 : 'ctyp) _ (loc : int * int) ->
+        (fun (t2 : 'ctyp) _ (t1 : 'ctyp) _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("CrCtr", [Qast.Loc; t1; t2]) : 'class_str_item));
       [Gramext.Stoken ("", "method");
        Gramext.srules
@@ -2820,32 +3137,37 @@ Grammar.extend
              (Gramext.srules
                 [[Gramext.Stoken ("", "private")],
                  Gramext.action
-                   (fun (x : string) (loc : int * int) ->
+                   (fun (x : string)
+                      (loc : Lexing.position * Lexing.position) ->
                       (Qast.Str x : 'e__17))])],
           Gramext.action
-            (fun (a : 'e__17 option) (loc : int * int) ->
+            (fun (a : 'e__17 option)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.Option a : 'a_opt));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_opt) (loc : int * int) -> (a : 'a_opt))];
+            (fun (a : 'a_opt) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_opt))];
        Gramext.Snterm (Grammar.Entry.obj (label : 'label Grammar.Entry.e));
        Gramext.srules
          [[Gramext.Sopt
              (Gramext.Snterm
                 (Grammar.Entry.obj (polyt : 'polyt Grammar.Entry.e)))],
           Gramext.action
-            (fun (a : 'polyt option) (loc : int * int) ->
+            (fun (a : 'polyt option)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.Option a : 'a_opt));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_opt) (loc : int * int) -> (a : 'a_opt))];
+            (fun (a : 'a_opt) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_opt))];
        Gramext.Snterm
          (Grammar.Entry.obj (fun_binding : 'fun_binding Grammar.Entry.e))],
       Gramext.action
         (fun (e : 'fun_binding) (topt : 'a_opt) (l : 'label) (pf : 'a_opt) _
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("CrMth", [Qast.Loc; l; o2b pf; e; topt]) :
             'class_str_item));
       [Gramext.Stoken ("", "method"); Gramext.Stoken ("", "virtual");
@@ -2854,20 +3176,24 @@ Grammar.extend
              (Gramext.srules
                 [[Gramext.Stoken ("", "private")],
                  Gramext.action
-                   (fun (x : string) (loc : int * int) ->
+                   (fun (x : string)
+                      (loc : Lexing.position * Lexing.position) ->
                       (Qast.Str x : 'e__16))])],
           Gramext.action
-            (fun (a : 'e__16 option) (loc : int * int) ->
+            (fun (a : 'e__16 option)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.Option a : 'a_opt));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_opt) (loc : int * int) -> (a : 'a_opt))];
+            (fun (a : 'a_opt) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_opt))];
        Gramext.Snterm (Grammar.Entry.obj (label : 'label Grammar.Entry.e));
        Gramext.Stoken ("", ":");
        Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))],
       Gramext.action
-        (fun (t : 'ctyp) _ (l : 'label) (pf : 'a_opt) _ _ (loc : int * int) ->
+        (fun (t : 'ctyp) _ (l : 'label) (pf : 'a_opt) _ _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("CrVir", [Qast.Loc; l; o2b pf; t]) : 'class_str_item));
       [Gramext.Stoken ("", "value");
        Gramext.srules
@@ -2875,22 +3201,25 @@ Grammar.extend
              (Gramext.srules
                 [[Gramext.Stoken ("", "mutable")],
                  Gramext.action
-                   (fun (x : string) (loc : int * int) ->
+                   (fun (x : string)
+                      (loc : Lexing.position * Lexing.position) ->
                       (Qast.Str x : 'e__15))])],
           Gramext.action
-            (fun (a : 'e__15 option) (loc : int * int) ->
+            (fun (a : 'e__15 option)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.Option a : 'a_opt));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_opt) (loc : int * int) -> (a : 'a_opt))];
+            (fun (a : 'a_opt) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_opt))];
        Gramext.Snterm (Grammar.Entry.obj (label : 'label Grammar.Entry.e));
        Gramext.Snterm
          (Grammar.Entry.obj
             (cvalue_binding : 'cvalue_binding Grammar.Entry.e))],
       Gramext.action
         (fun (e : 'cvalue_binding) (lab : 'label) (mf : 'a_opt) _
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("CrVal", [Qast.Loc; lab; o2b mf; e]) :
             'class_str_item));
       [Gramext.Stoken ("", "inherit");
@@ -2902,14 +3231,17 @@ Grammar.extend
                 (Grammar.Entry.obj
                    (as_lident : 'as_lident Grammar.Entry.e)))],
           Gramext.action
-            (fun (a : 'as_lident option) (loc : int * int) ->
+            (fun (a : 'as_lident option)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.Option a : 'a_opt));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_opt) (loc : int * int) -> (a : 'a_opt))]],
+            (fun (a : 'a_opt) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_opt))]],
       Gramext.action
-        (fun (pb : 'a_opt) (ce : 'class_expr) _ (loc : int * int) ->
+        (fun (pb : 'a_opt) (ce : 'class_expr) _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("CrInh", [Qast.Loc; ce; pb]) : 'class_str_item));
       [Gramext.Stoken ("", "declare");
        Gramext.srules
@@ -2920,18 +3252,21 @@ Grammar.extend
                        (class_str_item : 'class_str_item Grammar.Entry.e));
                   Gramext.Stoken ("", ";")],
                  Gramext.action
-                   (fun _ (s : 'class_str_item) (loc : int * int) ->
+                   (fun _ (s : 'class_str_item)
+                      (loc : Lexing.position * Lexing.position) ->
                       (s : 'e__14))])],
           Gramext.action
-            (fun (a : 'e__14 list) (loc : int * int) ->
+            (fun (a : 'e__14 list)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))];
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))];
        Gramext.Stoken ("", "end")],
       Gramext.action
-        (fun _ (st : 'a_list) _ (loc : int * int) ->
+        (fun _ (st : 'a_list) _ (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("CrDcl", [Qast.Loc; st]) : 'class_str_item))]];
     Grammar.Entry.obj (as_lident : 'as_lident Grammar.Entry.e), None,
     [None, None,
@@ -2939,12 +3274,15 @@ Grammar.extend
        Gramext.Snterm
          (Grammar.Entry.obj (a_LIDENT : 'a_LIDENT Grammar.Entry.e))],
       Gramext.action
-        (fun (i : 'a_LIDENT) _ (loc : int * int) -> (i : 'as_lident))]];
+        (fun (i : 'a_LIDENT) _ (loc : Lexing.position * Lexing.position) ->
+           (i : 'as_lident))]];
     Grammar.Entry.obj (polyt : 'polyt Grammar.Entry.e), None,
     [None, None,
      [[Gramext.Stoken ("", ":");
        Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))],
-      Gramext.action (fun (t : 'ctyp) _ (loc : int * int) -> (t : 'polyt))]];
+      Gramext.action
+        (fun (t : 'ctyp) _ (loc : Lexing.position * Lexing.position) ->
+           (t : 'polyt))]];
     Grammar.Entry.obj (cvalue_binding : 'cvalue_binding Grammar.Entry.e),
     None,
     [None, None,
@@ -2953,7 +3291,8 @@ Grammar.extend
        Gramext.Stoken ("", "=");
        Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))],
       Gramext.action
-        (fun (e : 'expr) _ (t : 'ctyp) _ (loc : int * int) ->
+        (fun (e : 'expr) _ (t : 'ctyp) _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("ExCoe", [Qast.Loc; e; Qast.Option None; t]) :
             'cvalue_binding));
       [Gramext.Stoken ("", ":");
@@ -2963,7 +3302,8 @@ Grammar.extend
        Gramext.Stoken ("", "=");
        Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))],
       Gramext.action
-        (fun (e : 'expr) _ (t2 : 'ctyp) _ (t : 'ctyp) _ (loc : int * int) ->
+        (fun (e : 'expr) _ (t2 : 'ctyp) _ (t : 'ctyp) _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("ExCoe", [Qast.Loc; e; Qast.Option (Some t); t2]) :
             'cvalue_binding));
       [Gramext.Stoken ("", ":");
@@ -2971,18 +3311,21 @@ Grammar.extend
        Gramext.Stoken ("", "=");
        Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))],
       Gramext.action
-        (fun (e : 'expr) _ (t : 'ctyp) _ (loc : int * int) ->
+        (fun (e : 'expr) _ (t : 'ctyp) _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("ExTyc", [Qast.Loc; e; t]) : 'cvalue_binding));
       [Gramext.Stoken ("", "=");
        Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))],
       Gramext.action
-        (fun (e : 'expr) _ (loc : int * int) -> (e : 'cvalue_binding))]];
+        (fun (e : 'expr) _ (loc : Lexing.position * Lexing.position) ->
+           (e : 'cvalue_binding))]];
     Grammar.Entry.obj (label : 'label Grammar.Entry.e), None,
     [None, None,
      [[Gramext.Snterm
          (Grammar.Entry.obj (a_LIDENT : 'a_LIDENT Grammar.Entry.e))],
       Gramext.action
-        (fun (i : 'a_LIDENT) (loc : int * int) -> (i : 'label))]];
+        (fun (i : 'a_LIDENT) (loc : Lexing.position * Lexing.position) ->
+           (i : 'label))]];
     Grammar.Entry.obj (class_type : 'class_type Grammar.Entry.e), None,
     [None, None,
      [[Gramext.Stoken ("", "object");
@@ -2992,12 +3335,14 @@ Grammar.extend
                 (Grammar.Entry.obj
                    (class_self_type : 'class_self_type Grammar.Entry.e)))],
           Gramext.action
-            (fun (a : 'class_self_type option) (loc : int * int) ->
+            (fun (a : 'class_self_type option)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.Option a : 'a_opt));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_opt) (loc : int * int) -> (a : 'a_opt))];
+            (fun (a : 'a_opt) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_opt))];
        Gramext.srules
          [[Gramext.Slist0
              (Gramext.srules
@@ -3006,24 +3351,29 @@ Grammar.extend
                        (class_sig_item : 'class_sig_item Grammar.Entry.e));
                   Gramext.Stoken ("", ";")],
                  Gramext.action
-                   (fun _ (csf : 'class_sig_item) (loc : int * int) ->
+                   (fun _ (csf : 'class_sig_item)
+                      (loc : Lexing.position * Lexing.position) ->
                       (csf : 'e__18))])],
           Gramext.action
-            (fun (a : 'e__18 list) (loc : int * int) ->
+            (fun (a : 'e__18 list)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))];
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))];
        Gramext.Stoken ("", "end")],
       Gramext.action
-        (fun _ (csf : 'a_list) (cst : 'a_opt) _ (loc : int * int) ->
+        (fun _ (csf : 'a_list) (cst : 'a_opt) _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("CtSig", [Qast.Loc; cst; csf]) : 'class_type));
       [Gramext.Snterm
          (Grammar.Entry.obj
             (clty_longident : 'clty_longident Grammar.Entry.e))],
       Gramext.action
-        (fun (id : 'clty_longident) (loc : int * int) ->
+        (fun (id : 'clty_longident)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("CtCon", [Qast.Loc; id; Qast.List []]) : 'class_type));
       [Gramext.Snterm
          (Grammar.Entry.obj
@@ -3035,21 +3385,24 @@ Grammar.extend
                 (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e)),
               Gramext.Stoken ("", ","))],
           Gramext.action
-            (fun (a : 'ctyp list) (loc : int * int) ->
+            (fun (a : 'ctyp list) (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))];
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))];
        Gramext.Stoken ("", "]")],
       Gramext.action
-        (fun _ (tl : 'a_list) _ (id : 'clty_longident) (loc : int * int) ->
+        (fun _ (tl : 'a_list) _ (id : 'clty_longident)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("CtCon", [Qast.Loc; id; tl]) : 'class_type));
       [Gramext.Stoken ("", "[");
        Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e));
        Gramext.Stoken ("", "]"); Gramext.Stoken ("", "->"); Gramext.Sself],
       Gramext.action
-        (fun (ct : 'class_type) _ _ (t : 'ctyp) _ (loc : int * int) ->
+        (fun (ct : 'class_type) _ _ (t : 'ctyp) _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("CtFun", [Qast.Loc; t; ct]) : 'class_type))]];
     Grammar.Entry.obj (class_self_type : 'class_self_type Grammar.Entry.e),
     None,
@@ -3058,7 +3411,8 @@ Grammar.extend
        Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e));
        Gramext.Stoken ("", ")")],
       Gramext.action
-        (fun _ (t : 'ctyp) _ (loc : int * int) -> (t : 'class_self_type))]];
+        (fun _ (t : 'ctyp) _ (loc : Lexing.position * Lexing.position) ->
+           (t : 'class_self_type))]];
     Grammar.Entry.obj (class_sig_item : 'class_sig_item Grammar.Entry.e),
     None,
     [None, None,
@@ -3067,7 +3421,8 @@ Grammar.extend
        Gramext.Stoken ("", "=");
        Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))],
       Gramext.action
-        (fun (t2 : 'ctyp) _ (t1 : 'ctyp) _ (loc : int * int) ->
+        (fun (t2 : 'ctyp) _ (t1 : 'ctyp) _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("CgCtr", [Qast.Loc; t1; t2]) : 'class_sig_item));
       [Gramext.Stoken ("", "method");
        Gramext.srules
@@ -3075,20 +3430,24 @@ Grammar.extend
              (Gramext.srules
                 [[Gramext.Stoken ("", "private")],
                  Gramext.action
-                   (fun (x : string) (loc : int * int) ->
+                   (fun (x : string)
+                      (loc : Lexing.position * Lexing.position) ->
                       (Qast.Str x : 'e__22))])],
           Gramext.action
-            (fun (a : 'e__22 option) (loc : int * int) ->
+            (fun (a : 'e__22 option)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.Option a : 'a_opt));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_opt) (loc : int * int) -> (a : 'a_opt))];
+            (fun (a : 'a_opt) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_opt))];
        Gramext.Snterm (Grammar.Entry.obj (label : 'label Grammar.Entry.e));
        Gramext.Stoken ("", ":");
        Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))],
       Gramext.action
-        (fun (t : 'ctyp) _ (l : 'label) (pf : 'a_opt) _ (loc : int * int) ->
+        (fun (t : 'ctyp) _ (l : 'label) (pf : 'a_opt) _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("CgMth", [Qast.Loc; l; o2b pf; t]) : 'class_sig_item));
       [Gramext.Stoken ("", "method"); Gramext.Stoken ("", "virtual");
        Gramext.srules
@@ -3096,20 +3455,24 @@ Grammar.extend
              (Gramext.srules
                 [[Gramext.Stoken ("", "private")],
                  Gramext.action
-                   (fun (x : string) (loc : int * int) ->
+                   (fun (x : string)
+                      (loc : Lexing.position * Lexing.position) ->
                       (Qast.Str x : 'e__21))])],
           Gramext.action
-            (fun (a : 'e__21 option) (loc : int * int) ->
+            (fun (a : 'e__21 option)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.Option a : 'a_opt));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_opt) (loc : int * int) -> (a : 'a_opt))];
+            (fun (a : 'a_opt) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_opt))];
        Gramext.Snterm (Grammar.Entry.obj (label : 'label Grammar.Entry.e));
        Gramext.Stoken ("", ":");
        Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))],
       Gramext.action
-        (fun (t : 'ctyp) _ (l : 'label) (pf : 'a_opt) _ _ (loc : int * int) ->
+        (fun (t : 'ctyp) _ (l : 'label) (pf : 'a_opt) _ _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("CgVir", [Qast.Loc; l; o2b pf; t]) : 'class_sig_item));
       [Gramext.Stoken ("", "value");
        Gramext.srules
@@ -3117,26 +3480,30 @@ Grammar.extend
              (Gramext.srules
                 [[Gramext.Stoken ("", "mutable")],
                  Gramext.action
-                   (fun (x : string) (loc : int * int) ->
+                   (fun (x : string)
+                      (loc : Lexing.position * Lexing.position) ->
                       (Qast.Str x : 'e__20))])],
           Gramext.action
-            (fun (a : 'e__20 option) (loc : int * int) ->
+            (fun (a : 'e__20 option)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.Option a : 'a_opt));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_opt) (loc : int * int) -> (a : 'a_opt))];
+            (fun (a : 'a_opt) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_opt))];
        Gramext.Snterm (Grammar.Entry.obj (label : 'label Grammar.Entry.e));
        Gramext.Stoken ("", ":");
        Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))],
       Gramext.action
-        (fun (t : 'ctyp) _ (l : 'label) (mf : 'a_opt) _ (loc : int * int) ->
+        (fun (t : 'ctyp) _ (l : 'label) (mf : 'a_opt) _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("CgVal", [Qast.Loc; l; o2b mf; t]) : 'class_sig_item));
       [Gramext.Stoken ("", "inherit");
        Gramext.Snterm
          (Grammar.Entry.obj (class_type : 'class_type Grammar.Entry.e))],
       Gramext.action
-        (fun (cs : 'class_type) _ (loc : int * int) ->
+        (fun (cs : 'class_type) _ (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("CgInh", [Qast.Loc; cs]) : 'class_sig_item));
       [Gramext.Stoken ("", "declare");
        Gramext.srules
@@ -3147,18 +3514,21 @@ Grammar.extend
                        (class_sig_item : 'class_sig_item Grammar.Entry.e));
                   Gramext.Stoken ("", ";")],
                  Gramext.action
-                   (fun _ (s : 'class_sig_item) (loc : int * int) ->
+                   (fun _ (s : 'class_sig_item)
+                      (loc : Lexing.position * Lexing.position) ->
                       (s : 'e__19))])],
           Gramext.action
-            (fun (a : 'e__19 list) (loc : int * int) ->
+            (fun (a : 'e__19 list)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))];
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))];
        Gramext.Stoken ("", "end")],
       Gramext.action
-        (fun _ (st : 'a_list) _ (loc : int * int) ->
+        (fun _ (st : 'a_list) _ (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("CgDcl", [Qast.Loc; st]) : 'class_sig_item))]];
     Grammar.Entry.obj
       (class_description : 'class_description Grammar.Entry.e),
@@ -3169,15 +3539,18 @@ Grammar.extend
              (Gramext.srules
                 [[Gramext.Stoken ("", "virtual")],
                  Gramext.action
-                   (fun (x : string) (loc : int * int) ->
+                   (fun (x : string)
+                      (loc : Lexing.position * Lexing.position) ->
                       (Qast.Str x : 'e__23))])],
           Gramext.action
-            (fun (a : 'e__23 option) (loc : int * int) ->
+            (fun (a : 'e__23 option)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.Option a : 'a_opt));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_opt) (loc : int * int) -> (a : 'a_opt))];
+            (fun (a : 'a_opt) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_opt))];
        Gramext.Snterm
          (Grammar.Entry.obj (a_LIDENT : 'a_LIDENT Grammar.Entry.e));
        Gramext.Snterm
@@ -3188,7 +3561,8 @@ Grammar.extend
          (Grammar.Entry.obj (class_type : 'class_type Grammar.Entry.e))],
       Gramext.action
         (fun (ct : 'class_type) _ (ctp : 'class_type_parameters)
-           (n : 'a_LIDENT) (vf : 'a_opt) (loc : int * int) ->
+           (n : 'a_LIDENT) (vf : 'a_opt)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Record
               ["ciLoc", Qast.Loc; "ciVir", o2b vf; "ciPrm", ctp; "ciNam", n;
                "ciExp", ct] :
@@ -3202,15 +3576,18 @@ Grammar.extend
              (Gramext.srules
                 [[Gramext.Stoken ("", "virtual")],
                  Gramext.action
-                   (fun (x : string) (loc : int * int) ->
+                   (fun (x : string)
+                      (loc : Lexing.position * Lexing.position) ->
                       (Qast.Str x : 'e__24))])],
           Gramext.action
-            (fun (a : 'e__24 option) (loc : int * int) ->
+            (fun (a : 'e__24 option)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.Option a : 'a_opt));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_opt) (loc : int * int) -> (a : 'a_opt))];
+            (fun (a : 'a_opt) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_opt))];
        Gramext.Snterm
          (Grammar.Entry.obj (a_LIDENT : 'a_LIDENT Grammar.Entry.e));
        Gramext.Snterm
@@ -3221,7 +3598,8 @@ Grammar.extend
          (Grammar.Entry.obj (class_type : 'class_type Grammar.Entry.e))],
       Gramext.action
         (fun (cs : 'class_type) _ (ctp : 'class_type_parameters)
-           (n : 'a_LIDENT) (vf : 'a_opt) (loc : int * int) ->
+           (n : 'a_LIDENT) (vf : 'a_opt)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Record
               ["ciLoc", Qast.Loc; "ciVir", o2b vf; "ciPrm", ctp; "ciNam", n;
                "ciExp", cs] :
@@ -3234,7 +3612,8 @@ Grammar.extend
          (Grammar.Entry.obj
             (class_longident : 'class_longident Grammar.Entry.e))],
       Gramext.action
-        (fun (i : 'class_longident) _ (loc : int * int) ->
+        (fun (i : 'class_longident) _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("ExNew", [Qast.Loc; i]) : 'expr))]];
     Grammar.Entry.obj (expr : 'expr Grammar.Entry.e),
     Some (Gramext.Level "."),
@@ -3242,7 +3621,8 @@ Grammar.extend
      [[Gramext.Sself; Gramext.Stoken ("", "#");
        Gramext.Snterm (Grammar.Entry.obj (label : 'label Grammar.Entry.e))],
       Gramext.action
-        (fun (lab : 'label) _ (e : 'expr) (loc : int * int) ->
+        (fun (lab : 'label) _ (e : 'expr)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("ExSnd", [Qast.Loc; e; lab]) : 'expr))]];
     Grammar.Entry.obj (expr : 'expr Grammar.Entry.e),
     Some (Gramext.Level "simple"),
@@ -3255,21 +3635,24 @@ Grammar.extend
                    (field_expr : 'field_expr Grammar.Entry.e)),
               Gramext.Stoken ("", ";"))],
           Gramext.action
-            (fun (a : 'field_expr list) (loc : int * int) ->
+            (fun (a : 'field_expr list)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))];
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))];
        Gramext.Stoken ("", ">}")],
       Gramext.action
-        (fun _ (fel : 'a_list) _ (loc : int * int) ->
+        (fun _ (fel : 'a_list) _ (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("ExOvr", [Qast.Loc; fel]) : 'expr));
       [Gramext.Stoken ("", "("); Gramext.Sself; Gramext.Stoken ("", ":>");
        Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e));
        Gramext.Stoken ("", ")")],
       Gramext.action
-        (fun _ (t : 'ctyp) _ (e : 'expr) _ (loc : int * int) ->
+        (fun _ (t : 'ctyp) _ (e : 'expr) _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("ExCoe", [Qast.Loc; e; Qast.Option None; t]) : 'expr));
       [Gramext.Stoken ("", "("); Gramext.Sself; Gramext.Stoken ("", ":");
        Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e));
@@ -3277,7 +3660,8 @@ Grammar.extend
        Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e));
        Gramext.Stoken ("", ")")],
       Gramext.action
-        (fun _ (t2 : 'ctyp) _ (t : 'ctyp) _ (e : 'expr) _ (loc : int * int) ->
+        (fun _ (t2 : 'ctyp) _ (t : 'ctyp) _ (e : 'expr) _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("ExCoe", [Qast.Loc; e; Qast.Option (Some t); t2]) :
             'expr))]];
     Grammar.Entry.obj (field_expr : 'field_expr Grammar.Entry.e), None,
@@ -3286,7 +3670,8 @@ Grammar.extend
        Gramext.Stoken ("", "=");
        Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))],
       Gramext.action
-        (fun (e : 'expr) _ (l : 'label) (loc : int * int) ->
+        (fun (e : 'expr) _ (l : 'label)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Tuple [l; e] : 'field_expr))]];
     Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e),
     Some (Gramext.Level "simple"),
@@ -3298,36 +3683,43 @@ Grammar.extend
                 (Grammar.Entry.obj (field : 'field Grammar.Entry.e)),
               Gramext.Stoken ("", ";"))],
           Gramext.action
-            (fun (a : 'field list) (loc : int * int) ->
+            (fun (a : 'field list)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))];
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))];
        Gramext.srules
          [[Gramext.Sopt
              (Gramext.srules
                 [[Gramext.Stoken ("", "..")],
                  Gramext.action
-                   (fun (x : string) (loc : int * int) ->
+                   (fun (x : string)
+                      (loc : Lexing.position * Lexing.position) ->
                       (Qast.Str x : 'e__25))])],
           Gramext.action
-            (fun (a : 'e__25 option) (loc : int * int) ->
+            (fun (a : 'e__25 option)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.Option a : 'a_opt));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_opt) (loc : int * int) -> (a : 'a_opt))];
+            (fun (a : 'a_opt) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_opt))];
        Gramext.Stoken ("", ">")],
       Gramext.action
-        (fun _ (v : 'a_opt) (ml : 'a_list) _ (loc : int * int) ->
+        (fun _ (v : 'a_opt) (ml : 'a_list) _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("TyObj", [Qast.Loc; ml; o2b v]) : 'ctyp));
       [Gramext.Stoken ("", "#");
        Gramext.Snterm
          (Grammar.Entry.obj
             (class_longident : 'class_longident Grammar.Entry.e))],
       Gramext.action
-        (fun (id : 'class_longident) _ (loc : int * int) ->
+        (fun (id : 'class_longident) _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("TyCls", [Qast.Loc; id]) : 'ctyp))]];
     Grammar.Entry.obj (field : 'field Grammar.Entry.e), None,
     [None, None,
@@ -3336,27 +3728,30 @@ Grammar.extend
        Gramext.Stoken ("", ":");
        Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))],
       Gramext.action
-        (fun (t : 'ctyp) _ (lab : 'a_LIDENT) (loc : int * int) ->
+        (fun (t : 'ctyp) _ (lab : 'a_LIDENT)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Tuple [lab; t] : 'field))]];
     Grammar.Entry.obj (typevar : 'typevar Grammar.Entry.e), None,
     [None, None,
      [[Gramext.Stoken ("", "'");
        Gramext.Snterm (Grammar.Entry.obj (ident : 'ident Grammar.Entry.e))],
       Gramext.action
-        (fun (i : 'ident) _ (loc : int * int) -> (i : 'typevar))]];
+        (fun (i : 'ident) _ (loc : Lexing.position * Lexing.position) ->
+           (i : 'typevar))]];
     Grammar.Entry.obj (clty_longident : 'clty_longident Grammar.Entry.e),
     None,
     [None, None,
      [[Gramext.Snterm
          (Grammar.Entry.obj (a_LIDENT : 'a_LIDENT Grammar.Entry.e))],
       Gramext.action
-        (fun (i : 'a_LIDENT) (loc : int * int) ->
+        (fun (i : 'a_LIDENT) (loc : Lexing.position * Lexing.position) ->
            (Qast.List [i] : 'clty_longident));
       [Gramext.Snterm
          (Grammar.Entry.obj (a_UIDENT : 'a_UIDENT Grammar.Entry.e));
        Gramext.Stoken ("", "."); Gramext.Sself],
       Gramext.action
-        (fun (l : 'clty_longident) _ (m : 'a_UIDENT) (loc : int * int) ->
+        (fun (l : 'clty_longident) _ (m : 'a_UIDENT)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Cons (m, l) : 'clty_longident))]];
     Grammar.Entry.obj (class_longident : 'class_longident Grammar.Entry.e),
     None,
@@ -3364,18 +3759,58 @@ Grammar.extend
      [[Gramext.Snterm
          (Grammar.Entry.obj (a_LIDENT : 'a_LIDENT Grammar.Entry.e))],
       Gramext.action
-        (fun (i : 'a_LIDENT) (loc : int * int) ->
+        (fun (i : 'a_LIDENT) (loc : Lexing.position * Lexing.position) ->
            (Qast.List [i] : 'class_longident));
       [Gramext.Snterm
          (Grammar.Entry.obj (a_UIDENT : 'a_UIDENT Grammar.Entry.e));
        Gramext.Stoken ("", "."); Gramext.Sself],
       Gramext.action
-        (fun (l : 'class_longident) _ (m : 'a_UIDENT) (loc : int * int) ->
+        (fun (l : 'class_longident) _ (m : 'a_UIDENT)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Cons (m, l) : 'class_longident))]];
     Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e),
     Some (Gramext.Level "simple"),
     [None, None,
-     [[Gramext.Stoken ("", "["); Gramext.Stoken ("", "<");
+     [[Gramext.Stoken ("", "[<");
+       Gramext.Snterm
+         (Grammar.Entry.obj
+            (row_field_list : 'row_field_list Grammar.Entry.e));
+       Gramext.Stoken ("", ">");
+       Gramext.srules
+         [[Gramext.Slist1
+             (Gramext.Snterm
+                (Grammar.Entry.obj (name_tag : 'name_tag Grammar.Entry.e)))],
+          Gramext.action
+            (fun (a : 'name_tag list)
+               (loc : Lexing.position * Lexing.position) ->
+               (Qast.List a : 'a_list));
+          [Gramext.Snterm
+             (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
+          Gramext.action
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))];
+       Gramext.Stoken ("", "]")],
+      Gramext.action
+        (fun _ (ntl : 'a_list) _ (rfl : 'row_field_list) _
+           (loc : Lexing.position * Lexing.position) ->
+           (Qast.Node
+              ("TyVrn",
+               [Qast.Loc; rfl; Qast.Option (Some (Qast.Option (Some ntl)))]) :
+            'ctyp));
+      [Gramext.Stoken ("", "[<");
+       Gramext.Snterm
+         (Grammar.Entry.obj
+            (row_field_list : 'row_field_list Grammar.Entry.e));
+       Gramext.Stoken ("", "]")],
+      Gramext.action
+        (fun _ (rfl : 'row_field_list) _
+           (loc : Lexing.position * Lexing.position) ->
+           (Qast.Node
+              ("TyVrn",
+               [Qast.Loc; rfl;
+                Qast.Option (Some (Qast.Option (Some (Qast.List []))))]) :
+            'ctyp));
+      [Gramext.Stoken ("", "["); Gramext.Stoken ("", "<");
        Gramext.Snterm
          (Grammar.Entry.obj
             (row_field_list : 'row_field_list Grammar.Entry.e));
@@ -3385,16 +3820,18 @@ Grammar.extend
              (Gramext.Snterm
                 (Grammar.Entry.obj (name_tag : 'name_tag Grammar.Entry.e)))],
           Gramext.action
-            (fun (a : 'name_tag list) (loc : int * int) ->
+            (fun (a : 'name_tag list)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))];
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))];
        Gramext.Stoken ("", "]")],
       Gramext.action
         (fun _ (ntl : 'a_list) _ (rfl : 'row_field_list) _ _
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node
               ("TyVrn",
                [Qast.Loc; rfl; Qast.Option (Some (Qast.Option (Some ntl)))]) :
@@ -3405,7 +3842,8 @@ Grammar.extend
             (row_field_list : 'row_field_list Grammar.Entry.e));
        Gramext.Stoken ("", "]")],
       Gramext.action
-        (fun _ (rfl : 'row_field_list) _ _ (loc : int * int) ->
+        (fun _ (rfl : 'row_field_list) _ _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node
               ("TyVrn",
                [Qast.Loc; rfl;
@@ -3417,7 +3855,8 @@ Grammar.extend
             (row_field_list : 'row_field_list Grammar.Entry.e));
        Gramext.Stoken ("", "]")],
       Gramext.action
-        (fun _ (rfl : 'row_field_list) _ _ (loc : int * int) ->
+        (fun _ (rfl : 'row_field_list) _ _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node
               ("TyVrn",
                [Qast.Loc; rfl; Qast.Option (Some (Qast.Option None))]) :
@@ -3428,7 +3867,8 @@ Grammar.extend
             (row_field_list : 'row_field_list Grammar.Entry.e));
        Gramext.Stoken ("", "]")],
       Gramext.action
-        (fun _ (rfl : 'row_field_list) _ _ (loc : int * int) ->
+        (fun _ (rfl : 'row_field_list) _ _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("TyVrn", [Qast.Loc; rfl; Qast.Option None]) :
             'ctyp))]];
     Grammar.Entry.obj (row_field_list : 'row_field_list Grammar.Entry.e),
@@ -3440,19 +3880,22 @@ Grammar.extend
                 (Grammar.Entry.obj (row_field : 'row_field Grammar.Entry.e)),
               Gramext.Stoken ("", "|"))],
           Gramext.action
-            (fun (a : 'row_field list) (loc : int * int) ->
+            (fun (a : 'row_field list)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))]],
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))]],
       Gramext.action
-        (fun (rfl : 'a_list) (loc : int * int) -> (rfl : 'row_field_list))]];
+        (fun (rfl : 'a_list) (loc : Lexing.position * Lexing.position) ->
+           (rfl : 'row_field_list))]];
     Grammar.Entry.obj (row_field : 'row_field Grammar.Entry.e), None,
     [None, None,
      [[Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))],
       Gramext.action
-        (fun (t : 'ctyp) (loc : int * int) ->
+        (fun (t : 'ctyp) (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("RfInh", [t]) : 'row_field));
       [Gramext.Stoken ("", "`");
        Gramext.Snterm (Grammar.Entry.obj (ident : 'ident Grammar.Entry.e));
@@ -3462,34 +3905,39 @@ Grammar.extend
              (Gramext.srules
                 [[Gramext.Stoken ("", "&")],
                  Gramext.action
-                   (fun (x : string) (loc : int * int) ->
+                   (fun (x : string)
+                      (loc : Lexing.position * Lexing.position) ->
                       (Qast.Str x : 'e__26))])],
           Gramext.action
-            (fun (a : 'e__26 option) (loc : int * int) ->
+            (fun (a : 'e__26 option)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.Option a : 'a_opt));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_opt) (loc : int * int) -> (a : 'a_opt))];
+            (fun (a : 'a_opt) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_opt))];
        Gramext.srules
          [[Gramext.Slist1sep
              (Gramext.Snterm
                 (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e)),
               Gramext.Stoken ("", "&"))],
           Gramext.action
-            (fun (a : 'ctyp list) (loc : int * int) ->
+            (fun (a : 'ctyp list) (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))]],
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))]],
       Gramext.action
-        (fun (l : 'a_list) (ao : 'a_opt) _ (i : 'ident) _ (loc : int * int) ->
+        (fun (l : 'a_list) (ao : 'a_opt) _ (i : 'ident) _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("RfTag", [i; o2b ao; l]) : 'row_field));
       [Gramext.Stoken ("", "`");
        Gramext.Snterm (Grammar.Entry.obj (ident : 'ident Grammar.Entry.e))],
       Gramext.action
-        (fun (i : 'ident) _ (loc : int * int) ->
+        (fun (i : 'ident) _ (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("RfTag", [i; Qast.Bool true; Qast.List []]) :
             'row_field))]];
     Grammar.Entry.obj (name_tag : 'name_tag Grammar.Entry.e), None,
@@ -3497,7 +3945,8 @@ Grammar.extend
      [[Gramext.Stoken ("", "`");
        Gramext.Snterm (Grammar.Entry.obj (ident : 'ident Grammar.Entry.e))],
       Gramext.action
-        (fun (i : 'ident) _ (loc : int * int) -> (i : 'name_tag))]];
+        (fun (i : 'ident) _ (loc : Lexing.position * Lexing.position) ->
+           (i : 'name_tag))]];
     Grammar.Entry.obj (patt : 'patt Grammar.Entry.e),
     Some (Gramext.Level "simple"),
     [None, None,
@@ -3509,15 +3958,18 @@ Grammar.extend
              (Gramext.Snterm
                 (Grammar.Entry.obj (eq_expr : 'eq_expr Grammar.Entry.e)))],
           Gramext.action
-            (fun (a : 'eq_expr option) (loc : int * int) ->
+            (fun (a : 'eq_expr option)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.Option a : 'a_opt));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_opt) (loc : int * int) -> (a : 'a_opt))];
+            (fun (a : 'a_opt) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_opt))];
        Gramext.Stoken ("", ")")],
       Gramext.action
-        (fun _ (eo : 'a_opt) (p : 'patt_tcon) _ _ (loc : int * int) ->
+        (fun _ (eo : 'a_opt) (p : 'patt_tcon) _ _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node
               ("PaOlb",
                [Qast.Loc; Qast.Str "";
@@ -3527,7 +3979,8 @@ Grammar.extend
          (Grammar.Entry.obj
             (a_QUESTIONIDENT : 'a_QUESTIONIDENT Grammar.Entry.e))],
       Gramext.action
-        (fun (i : 'a_QUESTIONIDENT) (loc : int * int) ->
+        (fun (i : 'a_QUESTIONIDENT)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("PaOlb", [Qast.Loc; i; Qast.Option None]) : 'patt));
       [Gramext.Snterm
          (Grammar.Entry.obj (a_OPTLABEL : 'a_OPTLABEL Grammar.Entry.e));
@@ -3539,16 +3992,18 @@ Grammar.extend
              (Gramext.Snterm
                 (Grammar.Entry.obj (eq_expr : 'eq_expr Grammar.Entry.e)))],
           Gramext.action
-            (fun (a : 'eq_expr option) (loc : int * int) ->
+            (fun (a : 'eq_expr option)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.Option a : 'a_opt));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_opt) (loc : int * int) -> (a : 'a_opt))];
+            (fun (a : 'a_opt) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_opt))];
        Gramext.Stoken ("", ")")],
       Gramext.action
         (fun _ (eo : 'a_opt) (p : 'patt_tcon) _ (i : 'a_OPTLABEL)
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node
               ("PaOlb",
                [Qast.Loc; i; Qast.Option (Some (Qast.Tuple [p; eo]))]) :
@@ -3564,16 +4019,18 @@ Grammar.extend
              (Gramext.Snterm
                 (Grammar.Entry.obj (eq_expr : 'eq_expr Grammar.Entry.e)))],
           Gramext.action
-            (fun (a : 'eq_expr option) (loc : int * int) ->
+            (fun (a : 'eq_expr option)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.Option a : 'a_opt));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_opt) (loc : int * int) -> (a : 'a_opt))];
+            (fun (a : 'a_opt) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_opt))];
        Gramext.Stoken ("", ")")],
       Gramext.action
         (fun _ (eo : 'a_opt) (p : 'patt_tcon) _ _ (i : 'a_QUESTIONIDENT)
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node
               ("PaOlb",
                [Qast.Loc; i; Qast.Option (Some (Qast.Tuple [p; eo]))]) :
@@ -3581,42 +4038,47 @@ Grammar.extend
       [Gramext.Snterm
          (Grammar.Entry.obj (a_TILDEIDENT : 'a_TILDEIDENT Grammar.Entry.e))],
       Gramext.action
-        (fun (i : 'a_TILDEIDENT) (loc : int * int) ->
+        (fun (i : 'a_TILDEIDENT) (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("PaLab", [Qast.Loc; i; Qast.Option None]) : 'patt));
       [Gramext.Snterm
          (Grammar.Entry.obj (a_LABEL : 'a_LABEL Grammar.Entry.e));
        Gramext.Sself],
       Gramext.action
-        (fun (p : 'patt) (i : 'a_LABEL) (loc : int * int) ->
+        (fun (p : 'patt) (i : 'a_LABEL)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("PaLab", [Qast.Loc; i; Qast.Option (Some p)]) :
             'patt));
       [Gramext.Snterm
          (Grammar.Entry.obj (a_TILDEIDENT : 'a_TILDEIDENT Grammar.Entry.e));
        Gramext.Stoken ("", ":"); Gramext.Sself],
       Gramext.action
-        (fun (p : 'patt) _ (i : 'a_TILDEIDENT) (loc : int * int) ->
+        (fun (p : 'patt) _ (i : 'a_TILDEIDENT)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("PaLab", [Qast.Loc; i; Qast.Option (Some p)]) :
             'patt));
       [Gramext.Stoken ("", "#");
        Gramext.Snterm
          (Grammar.Entry.obj (mod_ident : 'mod_ident Grammar.Entry.e))],
       Gramext.action
-        (fun (sl : 'mod_ident) _ (loc : int * int) ->
+        (fun (sl : 'mod_ident) _ (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("PaTyp", [Qast.Loc; sl]) : 'patt));
       [Gramext.Stoken ("", "`");
        Gramext.Snterm (Grammar.Entry.obj (ident : 'ident Grammar.Entry.e))],
       Gramext.action
-        (fun (s : 'ident) _ (loc : int * int) ->
+        (fun (s : 'ident) _ (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("PaVrn", [Qast.Loc; s]) : 'patt))]];
     Grammar.Entry.obj (patt_tcon : 'patt_tcon Grammar.Entry.e), None,
     [None, None,
      [[Gramext.Snterm (Grammar.Entry.obj (patt : 'patt Grammar.Entry.e))],
-      Gramext.action (fun (p : 'patt) (loc : int * int) -> (p : 'patt_tcon));
+      Gramext.action
+        (fun (p : 'patt) (loc : Lexing.position * Lexing.position) ->
+           (p : 'patt_tcon));
       [Gramext.Snterm (Grammar.Entry.obj (patt : 'patt Grammar.Entry.e));
        Gramext.Stoken ("", ":");
        Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))],
       Gramext.action
-        (fun (t : 'ctyp) _ (p : 'patt) (loc : int * int) ->
+        (fun (t : 'ctyp) _ (p : 'patt)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("PaTyc", [Qast.Loc; p; t]) : 'patt_tcon))]];
     Grammar.Entry.obj (ipatt : 'ipatt Grammar.Entry.e), None,
     [None, None,
@@ -3628,15 +4090,18 @@ Grammar.extend
              (Gramext.Snterm
                 (Grammar.Entry.obj (eq_expr : 'eq_expr Grammar.Entry.e)))],
           Gramext.action
-            (fun (a : 'eq_expr option) (loc : int * int) ->
+            (fun (a : 'eq_expr option)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.Option a : 'a_opt));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_opt) (loc : int * int) -> (a : 'a_opt))];
+            (fun (a : 'a_opt) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_opt))];
        Gramext.Stoken ("", ")")],
       Gramext.action
-        (fun _ (eo : 'a_opt) (p : 'ipatt_tcon) _ _ (loc : int * int) ->
+        (fun _ (eo : 'a_opt) (p : 'ipatt_tcon) _ _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node
               ("PaOlb",
                [Qast.Loc; Qast.Str "";
@@ -3646,7 +4111,8 @@ Grammar.extend
          (Grammar.Entry.obj
             (a_QUESTIONIDENT : 'a_QUESTIONIDENT Grammar.Entry.e))],
       Gramext.action
-        (fun (i : 'a_QUESTIONIDENT) (loc : int * int) ->
+        (fun (i : 'a_QUESTIONIDENT)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("PaOlb", [Qast.Loc; i; Qast.Option None]) : 'ipatt));
       [Gramext.Snterm
          (Grammar.Entry.obj (a_OPTLABEL : 'a_OPTLABEL Grammar.Entry.e));
@@ -3658,16 +4124,18 @@ Grammar.extend
              (Gramext.Snterm
                 (Grammar.Entry.obj (eq_expr : 'eq_expr Grammar.Entry.e)))],
           Gramext.action
-            (fun (a : 'eq_expr option) (loc : int * int) ->
+            (fun (a : 'eq_expr option)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.Option a : 'a_opt));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_opt) (loc : int * int) -> (a : 'a_opt))];
+            (fun (a : 'a_opt) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_opt))];
        Gramext.Stoken ("", ")")],
       Gramext.action
         (fun _ (eo : 'a_opt) (p : 'ipatt_tcon) _ (i : 'a_OPTLABEL)
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node
               ("PaOlb",
                [Qast.Loc; i; Qast.Option (Some (Qast.Tuple [p; eo]))]) :
@@ -3683,16 +4151,18 @@ Grammar.extend
              (Gramext.Snterm
                 (Grammar.Entry.obj (eq_expr : 'eq_expr Grammar.Entry.e)))],
           Gramext.action
-            (fun (a : 'eq_expr option) (loc : int * int) ->
+            (fun (a : 'eq_expr option)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.Option a : 'a_opt));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_opt) (loc : int * int) -> (a : 'a_opt))];
+            (fun (a : 'a_opt) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_opt))];
        Gramext.Stoken ("", ")")],
       Gramext.action
         (fun _ (eo : 'a_opt) (p : 'ipatt_tcon) _ _ (i : 'a_QUESTIONIDENT)
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node
               ("PaOlb",
                [Qast.Loc; i; Qast.Option (Some (Qast.Tuple [p; eo]))]) :
@@ -3700,39 +4170,44 @@ Grammar.extend
       [Gramext.Snterm
          (Grammar.Entry.obj (a_TILDEIDENT : 'a_TILDEIDENT Grammar.Entry.e))],
       Gramext.action
-        (fun (i : 'a_TILDEIDENT) (loc : int * int) ->
+        (fun (i : 'a_TILDEIDENT) (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("PaLab", [Qast.Loc; i; Qast.Option None]) : 'ipatt));
       [Gramext.Snterm
          (Grammar.Entry.obj (a_LABEL : 'a_LABEL Grammar.Entry.e));
        Gramext.Sself],
       Gramext.action
-        (fun (p : 'ipatt) (i : 'a_LABEL) (loc : int * int) ->
+        (fun (p : 'ipatt) (i : 'a_LABEL)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("PaLab", [Qast.Loc; i; Qast.Option (Some p)]) :
             'ipatt));
       [Gramext.Snterm
          (Grammar.Entry.obj (a_TILDEIDENT : 'a_TILDEIDENT Grammar.Entry.e));
        Gramext.Stoken ("", ":"); Gramext.Sself],
       Gramext.action
-        (fun (p : 'ipatt) _ (i : 'a_TILDEIDENT) (loc : int * int) ->
+        (fun (p : 'ipatt) _ (i : 'a_TILDEIDENT)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("PaLab", [Qast.Loc; i; Qast.Option (Some p)]) :
             'ipatt))]];
     Grammar.Entry.obj (ipatt_tcon : 'ipatt_tcon Grammar.Entry.e), None,
     [None, None,
      [[Gramext.Snterm (Grammar.Entry.obj (ipatt : 'ipatt Grammar.Entry.e))],
       Gramext.action
-        (fun (p : 'ipatt) (loc : int * int) -> (p : 'ipatt_tcon));
+        (fun (p : 'ipatt) (loc : Lexing.position * Lexing.position) ->
+           (p : 'ipatt_tcon));
       [Gramext.Snterm (Grammar.Entry.obj (ipatt : 'ipatt Grammar.Entry.e));
        Gramext.Stoken ("", ":");
        Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))],
       Gramext.action
-        (fun (t : 'ctyp) _ (p : 'ipatt) (loc : int * int) ->
+        (fun (t : 'ctyp) _ (p : 'ipatt)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("PaTyc", [Qast.Loc; p; t]) : 'ipatt_tcon))]];
     Grammar.Entry.obj (eq_expr : 'eq_expr Grammar.Entry.e), None,
     [None, None,
      [[Gramext.Stoken ("", "=");
        Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))],
       Gramext.action
-        (fun (e : 'expr) _ (loc : int * int) -> (e : 'eq_expr))]];
+        (fun (e : 'expr) _ (loc : Lexing.position * Lexing.position) ->
+           (e : 'eq_expr))]];
     Grammar.Entry.obj (expr : 'expr Grammar.Entry.e),
     Some (Gramext.After "apply"),
     [Some "label", Some Gramext.NonA,
@@ -3740,13 +4215,15 @@ Grammar.extend
          (Grammar.Entry.obj
             (a_QUESTIONIDENT : 'a_QUESTIONIDENT Grammar.Entry.e))],
       Gramext.action
-        (fun (i : 'a_QUESTIONIDENT) (loc : int * int) ->
+        (fun (i : 'a_QUESTIONIDENT)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("ExOlb", [Qast.Loc; i; Qast.Option None]) : 'expr));
       [Gramext.Snterm
          (Grammar.Entry.obj (a_OPTLABEL : 'a_OPTLABEL Grammar.Entry.e));
        Gramext.Sself],
       Gramext.action
-        (fun (e : 'expr) (i : 'a_OPTLABEL) (loc : int * int) ->
+        (fun (e : 'expr) (i : 'a_OPTLABEL)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("ExOlb", [Qast.Loc; i; Qast.Option (Some e)]) :
             'expr));
       [Gramext.Snterm
@@ -3754,26 +4231,29 @@ Grammar.extend
             (a_QUESTIONIDENT : 'a_QUESTIONIDENT Grammar.Entry.e));
        Gramext.Stoken ("", ":"); Gramext.Sself],
       Gramext.action
-        (fun (e : 'expr) _ (i : 'a_QUESTIONIDENT) (loc : int * int) ->
+        (fun (e : 'expr) _ (i : 'a_QUESTIONIDENT)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("ExOlb", [Qast.Loc; i; Qast.Option (Some e)]) :
             'expr));
       [Gramext.Snterm
          (Grammar.Entry.obj (a_TILDEIDENT : 'a_TILDEIDENT Grammar.Entry.e))],
       Gramext.action
-        (fun (i : 'a_TILDEIDENT) (loc : int * int) ->
+        (fun (i : 'a_TILDEIDENT) (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("ExLab", [Qast.Loc; i; Qast.Option None]) : 'expr));
       [Gramext.Snterm
          (Grammar.Entry.obj (a_LABEL : 'a_LABEL Grammar.Entry.e));
        Gramext.Sself],
       Gramext.action
-        (fun (e : 'expr) (i : 'a_LABEL) (loc : int * int) ->
+        (fun (e : 'expr) (i : 'a_LABEL)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("ExLab", [Qast.Loc; i; Qast.Option (Some e)]) :
             'expr));
       [Gramext.Snterm
          (Grammar.Entry.obj (a_TILDEIDENT : 'a_TILDEIDENT Grammar.Entry.e));
        Gramext.Stoken ("", ":"); Gramext.Sself],
       Gramext.action
-        (fun (e : 'expr) _ (i : 'a_TILDEIDENT) (loc : int * int) ->
+        (fun (e : 'expr) _ (i : 'a_TILDEIDENT)
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("ExLab", [Qast.Loc; i; Qast.Option (Some e)]) :
             'expr))]];
     Grammar.Entry.obj (expr : 'expr Grammar.Entry.e),
@@ -3782,17 +4262,19 @@ Grammar.extend
      [[Gramext.Stoken ("", "`");
        Gramext.Snterm (Grammar.Entry.obj (ident : 'ident Grammar.Entry.e))],
       Gramext.action
-        (fun (s : 'ident) _ (loc : int * int) ->
+        (fun (s : 'ident) _ (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("ExVrn", [Qast.Loc; s]) : 'expr))]];
     Grammar.Entry.obj (direction_flag : 'direction_flag Grammar.Entry.e),
     None,
     [None, None,
      [[Gramext.Stoken ("", "downto")],
       Gramext.action
-        (fun _ (loc : int * int) -> (Qast.Bool false : 'direction_flag));
+        (fun _ (loc : Lexing.position * Lexing.position) ->
+           (Qast.Bool false : 'direction_flag));
       [Gramext.Stoken ("", "to")],
       Gramext.action
-        (fun _ (loc : int * int) -> (Qast.Bool true : 'direction_flag))]];
+        (fun _ (loc : Lexing.position * Lexing.position) ->
+           (Qast.Bool true : 'direction_flag))]];
     Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e),
     Some (Gramext.Level "simple"),
     [None, None,
@@ -3810,16 +4292,18 @@ Grammar.extend
              (Gramext.Snterm
                 (Grammar.Entry.obj (name_tag : 'name_tag Grammar.Entry.e)))],
           Gramext.action
-            (fun (a : 'name_tag list) (loc : int * int) ->
+            (fun (a : 'name_tag list)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))];
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))];
        Gramext.Stoken ("", "|]")],
       Gramext.action
         (fun _ (ntl : 'a_list) _ (rfl : 'row_field_list) _ _ _
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node
               ("TyVrn",
                [Qast.Loc; rfl; Qast.Option (Some (Qast.Option (Some ntl)))]) :
@@ -3834,7 +4318,8 @@ Grammar.extend
             (row_field_list : 'row_field_list Grammar.Entry.e));
        Gramext.Stoken ("", "|]")],
       Gramext.action
-        (fun _ (rfl : 'row_field_list) _ _ _ (loc : int * int) ->
+        (fun _ (rfl : 'row_field_list) _ _ _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node
               ("TyVrn",
                [Qast.Loc; rfl;
@@ -3850,7 +4335,8 @@ Grammar.extend
             (row_field_list : 'row_field_list Grammar.Entry.e));
        Gramext.Stoken ("", "|]")],
       Gramext.action
-        (fun _ (rfl : 'row_field_list) _ _ _ (loc : int * int) ->
+        (fun _ (rfl : 'row_field_list) _ _ _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node
               ("TyVrn",
                [Qast.Loc; rfl; Qast.Option (Some (Qast.Option None))]) :
@@ -3864,7 +4350,8 @@ Grammar.extend
             (row_field_list : 'row_field_list Grammar.Entry.e));
        Gramext.Stoken ("", "|]")],
       Gramext.action
-        (fun _ (rfl : 'row_field_list) _ _ (loc : int * int) ->
+        (fun _ (rfl : 'row_field_list) _ _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("TyVrn", [Qast.Loc; rfl; Qast.Option None]) :
             'ctyp))]];
     Grammar.Entry.obj (warning_variant : 'warning_variant Grammar.Entry.e),
@@ -3872,7 +4359,7 @@ Grammar.extend
     [None, None,
      [[],
       Gramext.action
-        (fun (loc : int * int) ->
+        (fun (loc : Lexing.position * Lexing.position) ->
            (warn_variant Qast.Loc : 'warning_variant))]];
     Grammar.Entry.obj (expr : 'expr Grammar.Entry.e),
     Some (Gramext.Level "top"),
@@ -3885,20 +4372,25 @@ Grammar.extend
                     (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e));
                   Gramext.Stoken ("", ";")],
                  Gramext.action
-                   (fun _ (e : 'expr) (loc : int * int) -> (e : 'e__29))])],
+                   (fun _ (e : 'expr)
+                      (loc : Lexing.position * Lexing.position) ->
+                      (e : 'e__29))])],
           Gramext.action
-            (fun (a : 'e__29 list) (loc : int * int) ->
+            (fun (a : 'e__29 list)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))];
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))];
        Gramext.Snterm
          (Grammar.Entry.obj
             (warning_sequence : 'warning_sequence Grammar.Entry.e));
        Gramext.Stoken ("", "done")],
       Gramext.action
-        (fun _ _ (seq : 'a_list) _ (e : 'expr) _ (loc : int * int) ->
+        (fun _ _ (seq : 'a_list) _ (e : 'expr) _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("ExWhi", [Qast.Loc; e; seq]) : 'expr));
       [Gramext.Stoken ("", "for");
        Gramext.Snterm
@@ -3915,21 +4407,26 @@ Grammar.extend
                     (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e));
                   Gramext.Stoken ("", ";")],
                  Gramext.action
-                   (fun _ (e : 'expr) (loc : int * int) -> (e : 'e__28))])],
+                   (fun _ (e : 'expr)
+                      (loc : Lexing.position * Lexing.position) ->
+                      (e : 'e__28))])],
           Gramext.action
-            (fun (a : 'e__28 list) (loc : int * int) ->
+            (fun (a : 'e__28 list)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))];
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))];
        Gramext.Snterm
          (Grammar.Entry.obj
             (warning_sequence : 'warning_sequence Grammar.Entry.e));
        Gramext.Stoken ("", "done")],
       Gramext.action
         (fun _ _ (seq : 'a_list) _ (e2 : 'expr) (df : 'direction_flag)
-           (e1 : 'expr) _ (i : 'a_LIDENT) _ (loc : int * int) ->
+           (e1 : 'expr) _ (i : 'a_LIDENT) _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("ExFor", [Qast.Loc; i; e1; e2; df; seq]) : 'expr));
       [Gramext.Stoken ("", "do");
        Gramext.srules
@@ -3939,78 +4436,85 @@ Grammar.extend
                     (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e));
                   Gramext.Stoken ("", ";")],
                  Gramext.action
-                   (fun _ (e : 'expr) (loc : int * int) -> (e : 'e__27))])],
+                   (fun _ (e : 'expr)
+                      (loc : Lexing.position * Lexing.position) ->
+                      (e : 'e__27))])],
           Gramext.action
-            (fun (a : 'e__27 list) (loc : int * int) ->
+            (fun (a : 'e__27 list)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))];
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))];
        Gramext.Stoken ("", "return");
        Gramext.Snterm
          (Grammar.Entry.obj
             (warning_sequence : 'warning_sequence Grammar.Entry.e));
        Gramext.Sself],
       Gramext.action
-        (fun (e : 'expr) _ _ (seq : 'a_list) _ (loc : int * int) ->
+        (fun (e : 'expr) _ _ (seq : 'a_list) _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("ExSeq", [Qast.Loc; append_elem seq e]) : 'expr))]];
     Grammar.Entry.obj (warning_sequence : 'warning_sequence Grammar.Entry.e),
     None,
     [None, None,
      [[],
       Gramext.action
-        (fun (loc : int * int) ->
+        (fun (loc : Lexing.position * Lexing.position) ->
            (warn_sequence Qast.Loc : 'warning_sequence))]];
     Grammar.Entry.obj (sequence : 'sequence Grammar.Entry.e), None,
     [None, None,
      [[Gramext.Stoken ("ANTIQUOT", "list")],
       Gramext.action
-        (fun (a : string) (loc : int * int) ->
+        (fun (a : string) (loc : Lexing.position * Lexing.position) ->
            (antiquot "list" loc a : 'sequence))]];
     Grammar.Entry.obj (expr_ident : 'expr_ident Grammar.Entry.e), None,
     [None, None,
      [[Gramext.Stoken ("ANTIQUOT", "")],
       Gramext.action
-        (fun (a : string) (loc : int * int) ->
+        (fun (a : string) (loc : Lexing.position * Lexing.position) ->
            (antiquot "" loc a : 'expr_ident))]];
     Grammar.Entry.obj (patt_label_ident : 'patt_label_ident Grammar.Entry.e),
     Some (Gramext.Level "simple"),
     [None, None,
      [[Gramext.Stoken ("ANTIQUOT", "")],
       Gramext.action
-        (fun (a : string) (loc : int * int) ->
+        (fun (a : string) (loc : Lexing.position * Lexing.position) ->
            (antiquot "" loc a : 'patt_label_ident))]];
     Grammar.Entry.obj (when_expr_opt : 'when_expr_opt Grammar.Entry.e), None,
     [None, None,
      [[Gramext.Stoken ("ANTIQUOT", "when")],
       Gramext.action
-        (fun (a : string) (loc : int * int) ->
+        (fun (a : string) (loc : Lexing.position * Lexing.position) ->
            (antiquot "when" loc a : 'when_expr_opt))]];
     Grammar.Entry.obj (mod_ident : 'mod_ident Grammar.Entry.e), None,
     [None, None,
      [[Gramext.Stoken ("ANTIQUOT", "")],
       Gramext.action
-        (fun (a : string) (loc : int * int) ->
+        (fun (a : string) (loc : Lexing.position * Lexing.position) ->
            (antiquot "" loc a : 'mod_ident))]];
     Grammar.Entry.obj (clty_longident : 'clty_longident Grammar.Entry.e),
     None,
     [None, None,
      [[Gramext.Snterm (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
       Gramext.action
-        (fun (a : 'a_list) (loc : int * int) -> (a : 'clty_longident))]];
+        (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+           (a : 'clty_longident))]];
     Grammar.Entry.obj (class_longident : 'class_longident Grammar.Entry.e),
     None,
     [None, None,
      [[Gramext.Snterm (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
       Gramext.action
-        (fun (a : 'a_list) (loc : int * int) -> (a : 'class_longident))]];
+        (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+           (a : 'class_longident))]];
     Grammar.Entry.obj (direction_flag : 'direction_flag Grammar.Entry.e),
     None,
     [None, None,
      [[Gramext.Stoken ("ANTIQUOT", "to")],
       Gramext.action
-        (fun (a : string) (loc : int * int) ->
+        (fun (a : string) (loc : Lexing.position * Lexing.position) ->
            (antiquot "to" loc a : 'direction_flag))]];
     Grammar.Entry.obj (class_expr : 'class_expr Grammar.Entry.e),
     Some (Gramext.Level "simple"),
@@ -4025,18 +4529,22 @@ Grammar.extend
                        (class_str_item : 'class_str_item Grammar.Entry.e));
                   Gramext.Stoken ("", ";")],
                  Gramext.action
-                   (fun _ (cf : 'class_str_item) (loc : int * int) ->
+                   (fun _ (cf : 'class_str_item)
+                      (loc : Lexing.position * Lexing.position) ->
                       (cf : 'e__30))])],
           Gramext.action
-            (fun (a : 'e__30 list) (loc : int * int) ->
+            (fun (a : 'e__30 list)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))];
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))];
        Gramext.Stoken ("", "end")],
       Gramext.action
-        (fun _ (csl : 'a_list) _ (x : string) _ (loc : int * int) ->
+        (fun _ (csl : 'a_list) _ (x : string) _
+           (loc : Lexing.position * Lexing.position) ->
            (let _ = warn_antiq loc "3.05" in
             Qast.Node
               ("CeStr",
@@ -4049,7 +4557,8 @@ Grammar.extend
             (class_structure : 'class_structure Grammar.Entry.e));
        Gramext.Stoken ("", "end")],
       Gramext.action
-        (fun _ (cf : 'class_structure) (x : string) _ (loc : int * int) ->
+        (fun _ (cf : 'class_structure) (x : string) _
+           (loc : Lexing.position * Lexing.position) ->
            (let _ = warn_antiq loc "3.05" in
             Qast.Node ("CeStr", [Qast.Loc; antiquot "" loc x; cf]) :
             'class_expr))]];
@@ -4065,18 +4574,22 @@ Grammar.extend
                        (class_sig_item : 'class_sig_item Grammar.Entry.e));
                   Gramext.Stoken ("", ";")],
                  Gramext.action
-                   (fun _ (csf : 'class_sig_item) (loc : int * int) ->
+                   (fun _ (csf : 'class_sig_item)
+                      (loc : Lexing.position * Lexing.position) ->
                       (csf : 'e__32))])],
           Gramext.action
-            (fun (a : 'e__32 list) (loc : int * int) ->
+            (fun (a : 'e__32 list)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))];
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))];
        Gramext.Stoken ("", "end")],
       Gramext.action
-        (fun _ (csf : 'a_list) _ (x : string) _ (loc : int * int) ->
+        (fun _ (csf : 'a_list) _ (x : string) _
+           (loc : Lexing.position * Lexing.position) ->
            (let _ = warn_antiq loc "3.05" in
             Qast.Node
               ("CtSig",
@@ -4092,18 +4605,22 @@ Grammar.extend
                        (class_sig_item : 'class_sig_item Grammar.Entry.e));
                   Gramext.Stoken ("", ";")],
                  Gramext.action
-                   (fun _ (csf : 'class_sig_item) (loc : int * int) ->
+                   (fun _ (csf : 'class_sig_item)
+                      (loc : Lexing.position * Lexing.position) ->
                       (csf : 'e__31))])],
           Gramext.action
-            (fun (a : 'e__31 list) (loc : int * int) ->
+            (fun (a : 'e__31 list)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))];
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))];
        Gramext.Stoken ("", "end")],
       Gramext.action
-        (fun _ (csf : 'a_list) (x : string) _ (loc : int * int) ->
+        (fun _ (csf : 'a_list) (x : string) _
+           (loc : Lexing.position * Lexing.position) ->
            (let _ = warn_antiq loc "3.05" in
             Qast.Node ("CtSig", [Qast.Loc; antiquot "" loc x; csf]) :
             'class_type))]];
@@ -4118,15 +4635,18 @@ Grammar.extend
                    (let_binding : 'let_binding Grammar.Entry.e)),
               Gramext.Stoken ("", "and"))],
           Gramext.action
-            (fun (a : 'let_binding list) (loc : int * int) ->
+            (fun (a : 'let_binding list)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))];
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))];
        Gramext.Stoken ("", "in"); Gramext.Sself],
       Gramext.action
-        (fun (x : 'expr) _ (l : 'a_list) (r : string) _ (loc : int * int) ->
+        (fun (x : 'expr) _ (l : 'a_list) (r : string) _
+           (loc : Lexing.position * Lexing.position) ->
            (let _ = warn_antiq loc "3.06+18" in
             Qast.Node ("ExLet", [Qast.Loc; antiquot "rec" loc r; l; x]) :
             'expr))]];
@@ -4141,14 +4661,17 @@ Grammar.extend
                    (let_binding : 'let_binding Grammar.Entry.e)),
               Gramext.Stoken ("", "and"))],
           Gramext.action
-            (fun (a : 'let_binding list) (loc : int * int) ->
+            (fun (a : 'let_binding list)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))]],
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))]],
       Gramext.action
-        (fun (l : 'a_list) (r : string) _ (loc : int * int) ->
+        (fun (l : 'a_list) (r : string) _
+           (loc : Lexing.position * Lexing.position) ->
            (let _ = warn_antiq loc "3.06+18" in
             Qast.Node ("StVal", [Qast.Loc; antiquot "rec" loc r; l]) :
             'str_item))]];
@@ -4163,16 +4686,18 @@ Grammar.extend
                    (let_binding : 'let_binding Grammar.Entry.e)),
               Gramext.Stoken ("", "and"))],
           Gramext.action
-            (fun (a : 'let_binding list) (loc : int * int) ->
+            (fun (a : 'let_binding list)
+               (loc : Lexing.position * Lexing.position) ->
                (Qast.List a : 'a_list));
           [Gramext.Snterm
              (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
           Gramext.action
-            (fun (a : 'a_list) (loc : int * int) -> (a : 'a_list))];
+            (fun (a : 'a_list) (loc : Lexing.position * Lexing.position) ->
+               (a : 'a_list))];
        Gramext.Stoken ("", "in"); Gramext.Sself],
       Gramext.action
         (fun (ce : 'class_expr) _ (lb : 'a_list) (r : string) _
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (let _ = warn_antiq loc "3.06+18" in
             Qast.Node ("CeLet", [Qast.Loc; antiquot "rec" loc r; lb; ce]) :
             'class_expr))]];
@@ -4186,7 +4711,7 @@ Grammar.extend
             (cvalue_binding : 'cvalue_binding Grammar.Entry.e))],
       Gramext.action
         (fun (e : 'cvalue_binding) (lab : 'label) (mf : string) _
-           (loc : int * int) ->
+           (loc : Lexing.position * Lexing.position) ->
            (let _ = warn_antiq loc "3.06+18" in
             Qast.Node ("CrVal", [Qast.Loc; lab; antiquot "mut" loc mf; e]) :
             'class_str_item));
@@ -4195,7 +4720,8 @@ Grammar.extend
          (Grammar.Entry.obj (class_expr : 'class_expr Grammar.Entry.e));
        Gramext.Stoken ("ANTIQUOT", "as")],
       Gramext.action
-        (fun (pb : string) (ce : 'class_expr) _ (loc : int * int) ->
+        (fun (pb : string) (ce : 'class_expr) _
+           (loc : Lexing.position * Lexing.position) ->
            (let _ = warn_antiq loc "3.06+18" in
             Qast.Node ("CrInh", [Qast.Loc; ce; antiquot "as" loc pb]) :
             'class_str_item))]];
@@ -4207,7 +4733,8 @@ Grammar.extend
        Gramext.Stoken ("", ":");
        Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))],
       Gramext.action
-        (fun (t : 'ctyp) _ (l : 'label) (mf : string) _ (loc : int * int) ->
+        (fun (t : 'ctyp) _ (l : 'label) (mf : string) _
+           (loc : Lexing.position * Lexing.position) ->
            (let _ = warn_antiq loc "3.06+18" in
             Qast.Node ("CgVal", [Qast.Loc; l; antiquot "mut" loc mf; t]) :
             'class_sig_item))]]]);;
@@ -4229,7 +4756,8 @@ Grammar.extend
        Gramext.Snterm
          (Grammar.Entry.obj (dir_param : 'dir_param Grammar.Entry.e))],
       Gramext.action
-        (fun (dp : 'dir_param) (n : 'a_LIDENT) _ (loc : int * int) ->
+        (fun (dp : 'dir_param) (n : 'a_LIDENT) _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("StDir", [Qast.Loc; n; dp]) : 'str_item))]];
     Grammar.Entry.obj (sig_item : 'sig_item Grammar.Entry.e), None,
     [None, None,
@@ -4239,20 +4767,22 @@ Grammar.extend
        Gramext.Snterm
          (Grammar.Entry.obj (dir_param : 'dir_param Grammar.Entry.e))],
       Gramext.action
-        (fun (dp : 'dir_param) (n : 'a_LIDENT) _ (loc : int * int) ->
+        (fun (dp : 'dir_param) (n : 'a_LIDENT) _
+           (loc : Lexing.position * Lexing.position) ->
            (Qast.Node ("SgDir", [Qast.Loc; n; dp]) : 'sig_item))]];
     Grammar.Entry.obj (dir_param : 'dir_param Grammar.Entry.e), None,
     [None, None,
      [[],
       Gramext.action
-        (fun (loc : int * int) -> (Qast.Option None : 'dir_param));
+        (fun (loc : Lexing.position * Lexing.position) ->
+           (Qast.Option None : 'dir_param));
       [Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))],
       Gramext.action
-        (fun (e : 'expr) (loc : int * int) ->
+        (fun (e : 'expr) (loc : Lexing.position * Lexing.position) ->
            (Qast.Option (Some e) : 'dir_param));
       [Gramext.Stoken ("ANTIQUOT", "opt")],
       Gramext.action
-        (fun (a : string) (loc : int * int) ->
+        (fun (a : string) (loc : Lexing.position * Lexing.position) ->
            (antiquot "opt" loc a : 'dir_param))]]]);;
 
 (* Antiquotations *)
@@ -4263,44 +4793,44 @@ Grammar.extend
    [None, None,
     [[Gramext.Stoken ("ANTIQUOT", "")],
      Gramext.action
-       (fun (a : string) (loc : int * int) ->
+       (fun (a : string) (loc : Lexing.position * Lexing.position) ->
           (antiquot "" loc a : 'module_expr));
      [Gramext.Stoken ("ANTIQUOT", "mexp")],
      Gramext.action
-       (fun (a : string) (loc : int * int) ->
+       (fun (a : string) (loc : Lexing.position * Lexing.position) ->
           (antiquot "mexp" loc a : 'module_expr))]];
    Grammar.Entry.obj (str_item : 'str_item Grammar.Entry.e),
    Some (Gramext.Level "top"),
    [None, None,
     [[Gramext.Stoken ("ANTIQUOT", "")],
      Gramext.action
-       (fun (a : string) (loc : int * int) ->
+       (fun (a : string) (loc : Lexing.position * Lexing.position) ->
           (antiquot "" loc a : 'str_item));
      [Gramext.Stoken ("ANTIQUOT", "stri")],
      Gramext.action
-       (fun (a : string) (loc : int * int) ->
+       (fun (a : string) (loc : Lexing.position * Lexing.position) ->
           (antiquot "stri" loc a : 'str_item))]];
    Grammar.Entry.obj (module_type : 'module_type Grammar.Entry.e),
    Some (Gramext.Level "simple"),
    [None, None,
     [[Gramext.Stoken ("ANTIQUOT", "")],
      Gramext.action
-       (fun (a : string) (loc : int * int) ->
+       (fun (a : string) (loc : Lexing.position * Lexing.position) ->
           (antiquot "" loc a : 'module_type));
      [Gramext.Stoken ("ANTIQUOT", "mtyp")],
      Gramext.action
-       (fun (a : string) (loc : int * int) ->
+       (fun (a : string) (loc : Lexing.position * Lexing.position) ->
           (antiquot "mtyp" loc a : 'module_type))]];
    Grammar.Entry.obj (sig_item : 'sig_item Grammar.Entry.e),
    Some (Gramext.Level "top"),
    [None, None,
     [[Gramext.Stoken ("ANTIQUOT", "")],
      Gramext.action
-       (fun (a : string) (loc : int * int) ->
+       (fun (a : string) (loc : Lexing.position * Lexing.position) ->
           (antiquot "" loc a : 'sig_item));
      [Gramext.Stoken ("ANTIQUOT", "sigi")],
      Gramext.action
-       (fun (a : string) (loc : int * int) ->
+       (fun (a : string) (loc : Lexing.position * Lexing.position) ->
           (antiquot "sigi" loc a : 'sig_item))]];
    Grammar.Entry.obj (expr : 'expr Grammar.Entry.e),
    Some (Gramext.Level "simple"),
@@ -4309,18 +4839,19 @@ Grammar.extend
       Gramext.Snterm (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e));
       Gramext.Stoken ("", ")")],
      Gramext.action
-       (fun _ (el : 'a_list) _ (loc : int * int) ->
+       (fun _ (el : 'a_list) _ (loc : Lexing.position * Lexing.position) ->
           (Qast.Node ("ExTup", [Qast.Loc; el]) : 'expr));
      [Gramext.Stoken ("ANTIQUOT", "anti")],
      Gramext.action
-       (fun (a : string) (loc : int * int) ->
+       (fun (a : string) (loc : Lexing.position * Lexing.position) ->
           (Qast.Node ("ExAnt", [Qast.Loc; antiquot "anti" loc a]) : 'expr));
      [Gramext.Stoken ("ANTIQUOT", "")],
      Gramext.action
-       (fun (a : string) (loc : int * int) -> (antiquot "" loc a : 'expr));
+       (fun (a : string) (loc : Lexing.position * Lexing.position) ->
+          (antiquot "" loc a : 'expr));
      [Gramext.Stoken ("ANTIQUOT", "exp")],
      Gramext.action
-       (fun (a : string) (loc : int * int) ->
+       (fun (a : string) (loc : Lexing.position * Lexing.position) ->
           (antiquot "exp" loc a : 'expr))]];
    Grammar.Entry.obj (patt : 'patt Grammar.Entry.e),
    Some (Gramext.Level "simple"),
@@ -4329,18 +4860,19 @@ Grammar.extend
       Gramext.Snterm (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e));
       Gramext.Stoken ("", ")")],
      Gramext.action
-       (fun _ (pl : 'a_list) _ (loc : int * int) ->
+       (fun _ (pl : 'a_list) _ (loc : Lexing.position * Lexing.position) ->
           (Qast.Node ("PaTup", [Qast.Loc; pl]) : 'patt));
      [Gramext.Stoken ("ANTIQUOT", "anti")],
      Gramext.action
-       (fun (a : string) (loc : int * int) ->
+       (fun (a : string) (loc : Lexing.position * Lexing.position) ->
           (Qast.Node ("PaAnt", [Qast.Loc; antiquot "anti" loc a]) : 'patt));
      [Gramext.Stoken ("ANTIQUOT", "")],
      Gramext.action
-       (fun (a : string) (loc : int * int) -> (antiquot "" loc a : 'patt));
+       (fun (a : string) (loc : Lexing.position * Lexing.position) ->
+          (antiquot "" loc a : 'patt));
      [Gramext.Stoken ("ANTIQUOT", "pat")],
      Gramext.action
-       (fun (a : string) (loc : int * int) ->
+       (fun (a : string) (loc : Lexing.position * Lexing.position) ->
           (antiquot "pat" loc a : 'patt))]];
    Grammar.Entry.obj (ipatt : 'ipatt Grammar.Entry.e), None,
    [None, None,
@@ -4348,18 +4880,19 @@ Grammar.extend
       Gramext.Snterm (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e));
       Gramext.Stoken ("", ")")],
      Gramext.action
-       (fun _ (pl : 'a_list) _ (loc : int * int) ->
+       (fun _ (pl : 'a_list) _ (loc : Lexing.position * Lexing.position) ->
           (Qast.Node ("PaTup", [Qast.Loc; pl]) : 'ipatt));
      [Gramext.Stoken ("ANTIQUOT", "anti")],
      Gramext.action
-       (fun (a : string) (loc : int * int) ->
+       (fun (a : string) (loc : Lexing.position * Lexing.position) ->
           (Qast.Node ("PaAnt", [Qast.Loc; antiquot "anti" loc a]) : 'ipatt));
      [Gramext.Stoken ("ANTIQUOT", "")],
      Gramext.action
-       (fun (a : string) (loc : int * int) -> (antiquot "" loc a : 'ipatt));
+       (fun (a : string) (loc : Lexing.position * Lexing.position) ->
+          (antiquot "" loc a : 'ipatt));
      [Gramext.Stoken ("ANTIQUOT", "pat")],
      Gramext.action
-       (fun (a : string) (loc : int * int) ->
+       (fun (a : string) (loc : Lexing.position * Lexing.position) ->
           (antiquot "pat" loc a : 'ipatt))]];
    Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e),
    Some (Gramext.Level "simple"),
@@ -4368,39 +4901,40 @@ Grammar.extend
       Gramext.Snterm (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e));
       Gramext.Stoken ("", ")")],
      Gramext.action
-       (fun _ (tl : 'a_list) _ (loc : int * int) ->
+       (fun _ (tl : 'a_list) _ (loc : Lexing.position * Lexing.position) ->
           (Qast.Node ("TyTup", [Qast.Loc; tl]) : 'ctyp));
      [Gramext.Stoken ("ANTIQUOT", "")],
      Gramext.action
-       (fun (a : string) (loc : int * int) -> (antiquot "" loc a : 'ctyp));
+       (fun (a : string) (loc : Lexing.position * Lexing.position) ->
+          (antiquot "" loc a : 'ctyp));
      [Gramext.Stoken ("ANTIQUOT", "typ")],
      Gramext.action
-       (fun (a : string) (loc : int * int) ->
+       (fun (a : string) (loc : Lexing.position * Lexing.position) ->
           (antiquot "typ" loc a : 'ctyp))]];
    Grammar.Entry.obj (class_expr : 'class_expr Grammar.Entry.e),
    Some (Gramext.Level "simple"),
    [None, None,
     [[Gramext.Stoken ("ANTIQUOT", "")],
      Gramext.action
-       (fun (a : string) (loc : int * int) ->
+       (fun (a : string) (loc : Lexing.position * Lexing.position) ->
           (antiquot "" loc a : 'class_expr))]];
    Grammar.Entry.obj (class_str_item : 'class_str_item Grammar.Entry.e), None,
    [None, None,
     [[Gramext.Stoken ("ANTIQUOT", "")],
      Gramext.action
-       (fun (a : string) (loc : int * int) ->
+       (fun (a : string) (loc : Lexing.position * Lexing.position) ->
           (antiquot "" loc a : 'class_str_item))]];
    Grammar.Entry.obj (class_sig_item : 'class_sig_item Grammar.Entry.e), None,
    [None, None,
     [[Gramext.Stoken ("ANTIQUOT", "")],
      Gramext.action
-       (fun (a : string) (loc : int * int) ->
+       (fun (a : string) (loc : Lexing.position * Lexing.position) ->
           (antiquot "" loc a : 'class_sig_item))]];
    Grammar.Entry.obj (class_type : 'class_type Grammar.Entry.e), None,
    [None, None,
     [[Gramext.Stoken ("ANTIQUOT", "")],
      Gramext.action
-       (fun (a : string) (loc : int * int) ->
+       (fun (a : string) (loc : Lexing.position * Lexing.position) ->
           (antiquot "" loc a : 'class_type))]];
    Grammar.Entry.obj (expr : 'expr Grammar.Entry.e),
    Some (Gramext.Level "simple"),
@@ -4409,7 +4943,7 @@ Grammar.extend
       Gramext.Snterm (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e));
       Gramext.Stoken ("", ">}")],
      Gramext.action
-       (fun _ (fel : 'a_list) _ (loc : int * int) ->
+       (fun _ (fel : 'a_list) _ (loc : Lexing.position * Lexing.position) ->
           (Qast.Node ("ExOvr", [Qast.Loc; fel]) : 'expr))]];
    Grammar.Entry.obj (patt : 'patt Grammar.Entry.e),
    Some (Gramext.Level "simple"),
@@ -4417,125 +4951,179 @@ Grammar.extend
     [[Gramext.Stoken ("", "#");
       Gramext.Snterm (Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e))],
      Gramext.action
-       (fun (a : 'a_list) _ (loc : int * int) ->
+       (fun (a : 'a_list) _ (loc : Lexing.position * Lexing.position) ->
           (Qast.Node ("PaTyp", [Qast.Loc; a]) : 'patt))]];
    Grammar.Entry.obj (a_list : 'a_list Grammar.Entry.e), None,
    [None, None,
     [[Gramext.Stoken ("ANTIQUOT", "list")],
      Gramext.action
-       (fun (a : string) (loc : int * int) ->
+       (fun (a : string) (loc : Lexing.position * Lexing.position) ->
           (antiquot "list" loc a : 'a_list))]];
    Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e), None,
    [None, None,
     [[Gramext.Stoken ("ANTIQUOT", "opt")],
      Gramext.action
-       (fun (a : string) (loc : int * int) ->
+       (fun (a : string) (loc : Lexing.position * Lexing.position) ->
           (antiquot "opt" loc a : 'a_opt))]];
    Grammar.Entry.obj (a_UIDENT : 'a_UIDENT Grammar.Entry.e), None,
    [None, None,
     [[Gramext.Stoken ("UIDENT", "")],
      Gramext.action
-       (fun (i : string) (loc : int * int) -> (Qast.Str i : 'a_UIDENT));
+       (fun (i : string) (loc : Lexing.position * Lexing.position) ->
+          (Qast.Str i : 'a_UIDENT));
      [Gramext.Stoken ("ANTIQUOT", "")],
      Gramext.action
-       (fun (a : string) (loc : int * int) ->
+       (fun (a : string) (loc : Lexing.position * Lexing.position) ->
           (antiquot "" loc a : 'a_UIDENT));
      [Gramext.Stoken ("ANTIQUOT", "uid")],
      Gramext.action
-       (fun (a : string) (loc : int * int) ->
+       (fun (a : string) (loc : Lexing.position * Lexing.position) ->
           (antiquot "uid" loc a : 'a_UIDENT))]];
    Grammar.Entry.obj (a_LIDENT : 'a_LIDENT Grammar.Entry.e), None,
    [None, None,
     [[Gramext.Stoken ("LIDENT", "")],
      Gramext.action
-       (fun (i : string) (loc : int * int) -> (Qast.Str i : 'a_LIDENT));
+       (fun (i : string) (loc : Lexing.position * Lexing.position) ->
+          (Qast.Str i : 'a_LIDENT));
      [Gramext.Stoken ("ANTIQUOT", "")],
      Gramext.action
-       (fun (a : string) (loc : int * int) ->
+       (fun (a : string) (loc : Lexing.position * Lexing.position) ->
           (antiquot "" loc a : 'a_LIDENT));
      [Gramext.Stoken ("ANTIQUOT", "lid")],
      Gramext.action
-       (fun (a : string) (loc : int * int) ->
+       (fun (a : string) (loc : Lexing.position * Lexing.position) ->
           (antiquot "lid" loc a : 'a_LIDENT))]];
    Grammar.Entry.obj (a_INT : 'a_INT Grammar.Entry.e), None,
    [None, None,
     [[Gramext.Stoken ("INT", "")],
      Gramext.action
-       (fun (s : string) (loc : int * int) -> (Qast.Str s : 'a_INT));
+       (fun (s : string) (loc : Lexing.position * Lexing.position) ->
+          (Qast.Str s : 'a_INT));
      [Gramext.Stoken ("ANTIQUOT", "")],
      Gramext.action
-       (fun (a : string) (loc : int * int) -> (antiquot "" loc a : 'a_INT));
+       (fun (a : string) (loc : Lexing.position * Lexing.position) ->
+          (antiquot "" loc a : 'a_INT));
      [Gramext.Stoken ("ANTIQUOT", "int")],
      Gramext.action
-       (fun (a : string) (loc : int * int) ->
+       (fun (a : string) (loc : Lexing.position * Lexing.position) ->
           (antiquot "int" loc a : 'a_INT))]];
+   Grammar.Entry.obj (a_INT32 : 'a_INT32 Grammar.Entry.e), None,
+   [None, None,
+    [[Gramext.Stoken ("INT32", "")],
+     Gramext.action
+       (fun (s : string) (loc : Lexing.position * Lexing.position) ->
+          (Qast.Str s : 'a_INT32));
+     [Gramext.Stoken ("ANTIQUOT", "")],
+     Gramext.action
+       (fun (a : string) (loc : Lexing.position * Lexing.position) ->
+          (antiquot "" loc a : 'a_INT32));
+     [Gramext.Stoken ("ANTIQUOT", "int32")],
+     Gramext.action
+       (fun (a : string) (loc : Lexing.position * Lexing.position) ->
+          (antiquot "int32" loc a : 'a_INT32))]];
+   Grammar.Entry.obj (a_INT64 : 'a_INT64 Grammar.Entry.e), None,
+   [None, None,
+    [[Gramext.Stoken ("INT64", "")],
+     Gramext.action
+       (fun (s : string) (loc : Lexing.position * Lexing.position) ->
+          (Qast.Str s : 'a_INT64));
+     [Gramext.Stoken ("ANTIQUOT", "")],
+     Gramext.action
+       (fun (a : string) (loc : Lexing.position * Lexing.position) ->
+          (antiquot "" loc a : 'a_INT64));
+     [Gramext.Stoken ("ANTIQUOT", "int64")],
+     Gramext.action
+       (fun (a : string) (loc : Lexing.position * Lexing.position) ->
+          (antiquot "int64" loc a : 'a_INT64))]];
+   Grammar.Entry.obj (a_NATIVEINT : 'a_NATIVEINT Grammar.Entry.e), None,
+   [None, None,
+    [[Gramext.Stoken ("NATIVEINT", "")],
+     Gramext.action
+       (fun (s : string) (loc : Lexing.position * Lexing.position) ->
+          (Qast.Str s : 'a_NATIVEINT));
+     [Gramext.Stoken ("ANTIQUOT", "")],
+     Gramext.action
+       (fun (a : string) (loc : Lexing.position * Lexing.position) ->
+          (antiquot "" loc a : 'a_NATIVEINT));
+     [Gramext.Stoken ("ANTIQUOT", "nativeint")],
+     Gramext.action
+       (fun (a : string) (loc : Lexing.position * Lexing.position) ->
+          (antiquot "nativeint" loc a : 'a_NATIVEINT))]];
    Grammar.Entry.obj (a_FLOAT : 'a_FLOAT Grammar.Entry.e), None,
    [None, None,
     [[Gramext.Stoken ("FLOAT", "")],
      Gramext.action
-       (fun (s : string) (loc : int * int) -> (Qast.Str s : 'a_FLOAT));
+       (fun (s : string) (loc : Lexing.position * Lexing.position) ->
+          (Qast.Str s : 'a_FLOAT));
      [Gramext.Stoken ("ANTIQUOT", "")],
      Gramext.action
-       (fun (a : string) (loc : int * int) -> (antiquot "" loc a : 'a_FLOAT));
+       (fun (a : string) (loc : Lexing.position * Lexing.position) ->
+          (antiquot "" loc a : 'a_FLOAT));
      [Gramext.Stoken ("ANTIQUOT", "flo")],
      Gramext.action
-       (fun (a : string) (loc : int * int) ->
+       (fun (a : string) (loc : Lexing.position * Lexing.position) ->
           (antiquot "flo" loc a : 'a_FLOAT))]];
    Grammar.Entry.obj (a_STRING : 'a_STRING Grammar.Entry.e), None,
    [None, None,
     [[Gramext.Stoken ("STRING", "")],
      Gramext.action
-       (fun (s : string) (loc : int * int) -> (Qast.Str s : 'a_STRING));
+       (fun (s : string) (loc : Lexing.position * Lexing.position) ->
+          (Qast.Str s : 'a_STRING));
      [Gramext.Stoken ("ANTIQUOT", "")],
      Gramext.action
-       (fun (a : string) (loc : int * int) ->
+       (fun (a : string) (loc : Lexing.position * Lexing.position) ->
           (antiquot "" loc a : 'a_STRING));
      [Gramext.Stoken ("ANTIQUOT", "str")],
      Gramext.action
-       (fun (a : string) (loc : int * int) ->
+       (fun (a : string) (loc : Lexing.position * Lexing.position) ->
           (antiquot "str" loc a : 'a_STRING))]];
    Grammar.Entry.obj (a_CHAR : 'a_CHAR Grammar.Entry.e), None,
    [None, None,
     [[Gramext.Stoken ("CHAR", "")],
      Gramext.action
-       (fun (s : string) (loc : int * int) -> (Qast.Str s : 'a_CHAR));
+       (fun (s : string) (loc : Lexing.position * Lexing.position) ->
+          (Qast.Str s : 'a_CHAR));
      [Gramext.Stoken ("ANTIQUOT", "")],
      Gramext.action
-       (fun (a : string) (loc : int * int) -> (antiquot "" loc a : 'a_CHAR));
+       (fun (a : string) (loc : Lexing.position * Lexing.position) ->
+          (antiquot "" loc a : 'a_CHAR));
      [Gramext.Stoken ("ANTIQUOT", "chr")],
      Gramext.action
-       (fun (a : string) (loc : int * int) ->
+       (fun (a : string) (loc : Lexing.position * Lexing.position) ->
           (antiquot "chr" loc a : 'a_CHAR))]];
    Grammar.Entry.obj (a_TILDEIDENT : 'a_TILDEIDENT Grammar.Entry.e), None,
    [None, None,
     [[Gramext.Stoken ("TILDEIDENT", "")],
      Gramext.action
-       (fun (s : string) (loc : int * int) -> (Qast.Str s : 'a_TILDEIDENT));
+       (fun (s : string) (loc : Lexing.position * Lexing.position) ->
+          (Qast.Str s : 'a_TILDEIDENT));
      [Gramext.Stoken ("", "~"); Gramext.Stoken ("ANTIQUOT", "")],
      Gramext.action
-       (fun (a : string) _ (loc : int * int) ->
+       (fun (a : string) _ (loc : Lexing.position * Lexing.position) ->
           (antiquot "" loc a : 'a_TILDEIDENT))]];
    Grammar.Entry.obj (a_LABEL : 'a_LABEL Grammar.Entry.e), None,
    [None, None,
     [[Gramext.Stoken ("LABEL", "")],
      Gramext.action
-       (fun (s : string) (loc : int * int) -> (Qast.Str s : 'a_LABEL))]];
+       (fun (s : string) (loc : Lexing.position * Lexing.position) ->
+          (Qast.Str s : 'a_LABEL))]];
    Grammar.Entry.obj (a_QUESTIONIDENT : 'a_QUESTIONIDENT Grammar.Entry.e),
    None,
    [None, None,
     [[Gramext.Stoken ("QUESTIONIDENT", "")],
      Gramext.action
-       (fun (s : string) (loc : int * int) ->
+       (fun (s : string) (loc : Lexing.position * Lexing.position) ->
           (Qast.Str s : 'a_QUESTIONIDENT));
      [Gramext.Stoken ("", "?"); Gramext.Stoken ("ANTIQUOT", "")],
      Gramext.action
-       (fun (a : string) _ (loc : int * int) ->
+       (fun (a : string) _ (loc : Lexing.position * Lexing.position) ->
           (antiquot "" loc a : 'a_QUESTIONIDENT))]];
    Grammar.Entry.obj (a_OPTLABEL : 'a_OPTLABEL Grammar.Entry.e), None,
    [None, None,
     [[Gramext.Stoken ("OPTLABEL", "")],
      Gramext.action
-       (fun (s : string) (loc : int * int) -> (Qast.Str s : 'a_OPTLABEL))]]];;
+       (fun (s : string) (loc : Lexing.position * Lexing.position) ->
+          (Qast.Str s : 'a_OPTLABEL))]]];;
 
 let apply_entry e =
   let f s = Grammar.Entry.parse e (Stream.of_string s) in
@@ -4551,7 +5139,8 @@ Grammar.extend
         (Grammar.Entry.obj (sig_item : 'sig_item Grammar.Entry.e));
       Gramext.Stoken ("EOI", "")],
      Gramext.action
-       (fun _ (x : 'sig_item) (loc : int * int) -> (x : 'sig_item_eoi))]]];
+       (fun _ (x : 'sig_item) (loc : Lexing.position * Lexing.position) ->
+          (x : 'sig_item_eoi))]]];
 Quotation.add "sig_item" (apply_entry sig_item_eoi);;
 
 let str_item_eoi = Grammar.Entry.create gram "structure item" in
@@ -4562,7 +5151,8 @@ Grammar.extend
         (Grammar.Entry.obj (str_item : 'str_item Grammar.Entry.e));
       Gramext.Stoken ("EOI", "")],
      Gramext.action
-       (fun _ (x : 'str_item) (loc : int * int) -> (x : 'str_item_eoi))]]];
+       (fun _ (x : 'str_item) (loc : Lexing.position * Lexing.position) ->
+          (x : 'str_item_eoi))]]];
 Quotation.add "str_item" (apply_entry str_item_eoi);;
 
 let ctyp_eoi = Grammar.Entry.create gram "type" in
@@ -4572,7 +5162,8 @@ Grammar.extend
     [[Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e));
       Gramext.Stoken ("EOI", "")],
      Gramext.action
-       (fun _ (x : 'ctyp) (loc : int * int) -> (x : 'ctyp_eoi))]]];
+       (fun _ (x : 'ctyp) (loc : Lexing.position * Lexing.position) ->
+          (x : 'ctyp_eoi))]]];
 Quotation.add "ctyp" (apply_entry ctyp_eoi);;
 
 let patt_eoi = Grammar.Entry.create gram "pattern" in
@@ -4582,7 +5173,8 @@ Grammar.extend
     [[Gramext.Snterm (Grammar.Entry.obj (patt : 'patt Grammar.Entry.e));
       Gramext.Stoken ("EOI", "")],
      Gramext.action
-       (fun _ (x : 'patt) (loc : int * int) -> (x : 'patt_eoi))]]];
+       (fun _ (x : 'patt) (loc : Lexing.position * Lexing.position) ->
+          (x : 'patt_eoi))]]];
 Quotation.add "patt" (apply_entry patt_eoi);;
 
 let expr_eoi = Grammar.Entry.create gram "expression" in
@@ -4592,7 +5184,8 @@ Grammar.extend
     [[Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e));
       Gramext.Stoken ("EOI", "")],
      Gramext.action
-       (fun _ (x : 'expr) (loc : int * int) -> (x : 'expr_eoi))]]];
+       (fun _ (x : 'expr) (loc : Lexing.position * Lexing.position) ->
+          (x : 'expr_eoi))]]];
 Quotation.add "expr" (apply_entry expr_eoi);;
 
 let module_type_eoi = Grammar.Entry.create gram "module type" in
@@ -4604,7 +5197,7 @@ Grammar.extend
         (Grammar.Entry.obj (module_type : 'module_type Grammar.Entry.e));
       Gramext.Stoken ("EOI", "")],
      Gramext.action
-       (fun _ (x : 'module_type) (loc : int * int) ->
+       (fun _ (x : 'module_type) (loc : Lexing.position * Lexing.position) ->
           (x : 'module_type_eoi))]]];
 Quotation.add "module_type" (apply_entry module_type_eoi);;
 
@@ -4617,7 +5210,7 @@ Grammar.extend
         (Grammar.Entry.obj (module_expr : 'module_expr Grammar.Entry.e));
       Gramext.Stoken ("EOI", "")],
      Gramext.action
-       (fun _ (x : 'module_expr) (loc : int * int) ->
+       (fun _ (x : 'module_expr) (loc : Lexing.position * Lexing.position) ->
           (x : 'module_expr_eoi))]]];
 Quotation.add "module_expr" (apply_entry module_expr_eoi);;
 
@@ -4629,7 +5222,7 @@ Grammar.extend
         (Grammar.Entry.obj (class_type : 'class_type Grammar.Entry.e));
       Gramext.Stoken ("EOI", "")],
      Gramext.action
-       (fun _ (x : 'class_type) (loc : int * int) ->
+       (fun _ (x : 'class_type) (loc : Lexing.position * Lexing.position) ->
           (x : 'class_type_eoi))]]];
 Quotation.add "class_type" (apply_entry class_type_eoi);;
 
@@ -4641,7 +5234,7 @@ Grammar.extend
         (Grammar.Entry.obj (class_expr : 'class_expr Grammar.Entry.e));
       Gramext.Stoken ("EOI", "")],
      Gramext.action
-       (fun _ (x : 'class_expr) (loc : int * int) ->
+       (fun _ (x : 'class_expr) (loc : Lexing.position * Lexing.position) ->
           (x : 'class_expr_eoi))]]];
 Quotation.add "class_expr" (apply_entry class_expr_eoi);;
 
@@ -4656,7 +5249,8 @@ Grammar.extend
            (class_sig_item : 'class_sig_item Grammar.Entry.e));
       Gramext.Stoken ("EOI", "")],
      Gramext.action
-       (fun _ (x : 'class_sig_item) (loc : int * int) ->
+       (fun _ (x : 'class_sig_item)
+          (loc : Lexing.position * Lexing.position) ->
           (x : 'class_sig_item_eoi))]]];
 Quotation.add "class_sig_item" (apply_entry class_sig_item_eoi);;
 
@@ -4671,7 +5265,8 @@ Grammar.extend
            (class_str_item : 'class_str_item Grammar.Entry.e));
       Gramext.Stoken ("EOI", "")],
      Gramext.action
-       (fun _ (x : 'class_str_item) (loc : int * int) ->
+       (fun _ (x : 'class_str_item)
+          (loc : Lexing.position * Lexing.position) ->
           (x : 'class_str_item_eoi))]]];
 Quotation.add "class_str_item" (apply_entry class_str_item_eoi);;
 
@@ -4684,7 +5279,7 @@ Grammar.extend
         (Grammar.Entry.obj (with_constr : 'with_constr Grammar.Entry.e));
       Gramext.Stoken ("EOI", "")],
      Gramext.action
-       (fun _ (x : 'with_constr) (loc : int * int) ->
+       (fun _ (x : 'with_constr) (loc : Lexing.position * Lexing.position) ->
           (x : 'with_constr_eoi))]]];
 Quotation.add "with_constr" (apply_entry with_constr_eoi);;
 
@@ -4696,5 +5291,6 @@ Grammar.extend
         (Grammar.Entry.obj (row_field : 'row_field Grammar.Entry.e));
       Gramext.Stoken ("EOI", "")],
      Gramext.action
-       (fun _ (x : 'row_field) (loc : int * int) -> (x : 'row_field_eoi))]]];
+       (fun _ (x : 'row_field) (loc : Lexing.position * Lexing.position) ->
+          (x : 'row_field_eoi))]]];
 Quotation.add "row_field" (apply_entry row_field_eoi);;
diff --git a/camlp4/ocaml_src/odyl/.depend b/camlp4/ocaml_src/odyl/.depend
index b63c10b0b6..7823dd01b0 100644
--- a/camlp4/ocaml_src/odyl/.depend
+++ b/camlp4/ocaml_src/odyl/.depend
@@ -1,6 +1,6 @@
+odyl.cmo: odyl_config.cmo odyl_main.cmi 
+odyl.cmx: odyl_config.cmx odyl_main.cmx 
 odyl_main.cmo: $(OTOP)/otherlibs/dynlink/dynlink.cmi odyl_config.cmo \
     odyl_main.cmi 
 odyl_main.cmx: odyl_config.cmx \
     odyl_main.cmi 
-odyl.cmo: odyl_config.cmo odyl_main.cmi 
-odyl.cmx: odyl_config.cmx odyl_main.cmx 
diff --git a/camlp4/ocpp/Makefile b/camlp4/ocpp/Makefile
index 60729e323c..f3d844d0cb 100644
--- a/camlp4/ocpp/Makefile
+++ b/camlp4/ocpp/Makefile
@@ -12,7 +12,7 @@ OBJS=ocpp.cmo
 all: ocpp$(EXE)
 
 ocpp$(EXE): $(OBJS)
-	$(OCAMLC) $(LINKFLAGS) ../boot/stdpp.cmo ../camlp4/quotation.cmo ../odyl/odyl.cma $(OBJS) ../odyl/odyl.cmo -linkall -o ocpp$(EXE)
+	$(OCAMLC) $(LINKFLAGS) ../boot/stdpp.cmo ../camlp4/reloc.cmo ../camlp4/quotation.cmo ../odyl/odyl.cma $(OBJS) ../odyl/odyl.cmo -linkall -o ocpp$(EXE)
 
 clean::
 	rm -f *.cm[ioa] *.pp[io] *.o *.out *.bak .*.bak ocpp$(EXE)
diff --git a/camlp4/ocpp/ocpp.ml b/camlp4/ocpp/ocpp.ml
index afe517c0e5..92c939455b 100644
--- a/camlp4/ocpp/ocpp.ml
+++ b/camlp4/ocpp/ocpp.ml
@@ -46,7 +46,16 @@ and inside_locate cs =
   | [: :] -> raise (Stream.Error "end of file in locate directive") ]
 ;
 
+value nowhere = {
+  Lexing.pos_fname = "";
+  Lexing.pos_lnum = 0;
+  Lexing.pos_bol = 0;
+  Lexing.pos_cnum = 0
+}
+;
+
 value quot name pos str =
+  let pos = Reloc.shift_pos pos nowhere in
   let exp =
     try
       match Quotation.find name with
@@ -54,13 +63,13 @@ value quot name pos str =
       | _ -> raise Not_found ]
     with
     [ Not_found ->
-        Stdpp.raise_with_loc (pos, pos + String.length str) Not_found ]
+        Stdpp.raise_with_loc (pos, Reloc.shift_pos  (String.length str) pos) Not_found ]
   in
   let new_str =
     try exp True str with
     [ Stdpp.Exc_located (p1, p2) exc ->
-        Stdpp.raise_with_loc (pos + p1, pos + p2) exc
-    | exc -> Stdpp.raise_with_loc (pos, pos + String.length str) exc ]
+        Stdpp.raise_with_loc (Reloc.adjust_loc pos (p1, p2)) exc
+    | exc -> Stdpp.raise_with_loc (pos, Reloc.shift_pos (String.length str) pos) exc ]
   in
   let cs = Stream.of_string new_str in copy_strip_locate cs
 ;
diff --git a/camlp4/tools/camlp4_comm.sh b/camlp4/tools/camlp4_comm.sh
index b6bb8f87ed..61189dae13 100755
--- a/camlp4/tools/camlp4_comm.sh
+++ b/camlp4/tools/camlp4_comm.sh
@@ -1,4 +1,5 @@
 #!/bin/sh
+=======
 # $Id$
 
 ARGS1=
@@ -24,7 +25,7 @@ if test "$2" = "camlp4r" -o "$2" = "camlp4"; then
         fi
         shift; shift
         ARGS2=`echo $* | sed -e "s/[()*]//g"`
-#        ARGS1="$ARGS1 -verbose"
+        ARGS1="$ARGS1 -verbose"
         if test "$QUIET" = "no"; then echo $COMM $ARGS2 $ARGS1 $FILE; fi
         $COMM $ARGS2 $ARGS1 $FILE
 else
diff --git a/camlp4/top/Makefile b/camlp4/top/Makefile
index 4ea4e46bc2..d2b795e86c 100644
--- a/camlp4/top/Makefile
+++ b/camlp4/top/Makefile
@@ -5,15 +5,17 @@ include ../config/Makefile
 INCLUDES=-I ../camlp4 -I ../boot -I $(OTOP)/utils -I $(OTOP)/parsing -I $(OTOP)/typing -I $(OTOP)/toplevel
 OCAMLCFLAGS=-warn-error A $(INCLUDES)
 
-CAMLP4_OBJS=$(OTOP)/utils/config.cmo ../boot/stdpp.cmo ../boot/token.cmo ../boot/plexer.cmo ../boot/gramext.cmo ../boot/grammar.cmo ../boot/extfold.cmo ../boot/extfun.cmo ../boot/fstream.cmo ../camlp4/quotation.cmo ../camlp4/ast2pt.cmo ../camlp4/reloc.cmo ../camlp4/spretty.cmo ../camlp4/pcaml.cmo
+CAMLP4_OBJS=$(OTOP)/utils/config.cmo ../boot/stdpp.cmo ../boot/token.cmo ../boot/plexer.cmo ../boot/gramext.cmo ../boot/grammar.cmo ../boot/extfold.cmo ../boot/extfun.cmo ../boot/fstream.cmo ../camlp4/quotation.cmo  ../camlp4/reloc.cmo ../camlp4/spretty.cmo ../camlp4/pcaml.cmo ../camlp4/ast2pt.cmo
 TOP=camlp4_top.cmo
 ROBJS=$(CAMLP4_OBJS) ../meta/pa_r.cmo ../meta/pa_rp.cmo rprint.cmo $(TOP)
-SOBJS=$(CAMLP4_OBJS) ../etc/pa_scheme.cmo $(TOP)
+# pa_scheme needs to use new locations SOBJS=$(CAMLP4_OBJS) ../etc/pa_scheme.cmo $(TOP)
+SOBJS=$(CAMLP4_OBJS) $(TOP)
 OOBJS=$(CAMLP4_OBJS) ../etc/pa_o.cmo ../etc/pa_op.cmo $(TOP)
 OOOBJS=$(CAMLP4_OBJS) ../etc/pa_o.cmo ../etc/pa_oop.cmo $(TOP)
-OBJS=$(OTOP)/utils/config.cmo ../camlp4/quotation.cmo ../camlp4/reloc.cmo ../camlp4/ast2pt.cmo ../camlp4/spretty.cmo ../camlp4/pcaml.cmo camlp4_top.cmo
+OBJS=$(OTOP)/utils/config.cmo ../camlp4/quotation.cmo ../camlp4/reloc.cmo ../camlp4/spretty.cmo ../camlp4/pcaml.cmo ../camlp4/ast2pt.cmo camlp4_top.cmo
 
-TARGET=camlp4o.cma camlp4r.cma camlp4sch.cma camlp4_top.cma
+# camlp4sch.cma needs to use new locations TARGET=camlp4o.cma camlp4r.cma camlp4sch.cma camlp4_top.cma
+TARGET=camlp4o.cma camlp4r.cma camlp4_top.cma
 
 all: $(TARGET)
 
diff --git a/camlp4/top/camlp4_top.ml b/camlp4/top/camlp4_top.ml
index 4d0d12f785..65d7d643d7 100644
--- a/camlp4/top/camlp4_top.ml
+++ b/camlp4/top/camlp4_top.ml
@@ -59,8 +59,9 @@ value highlight_locations lb loc1 loc2 =
 
 value print_location lb loc =
   if String.length Toploop.input_name.val = 0 then
-    highlight_locations lb loc (-1, -1)
-  else Toploop.print_location Format.err_formatter (Ast2pt.mkloc loc)
+    highlight_locations lb ((fst loc).Lexing.pos_cnum, (snd loc).Lexing.pos_cnum) (-1, -1)
+  else Toploop.print_location Format.err_formatter
+    (Ast2pt.mkloc loc)
 ;
 
 value wrap f shfn lb =
diff --git a/camlp4/top/rprint.ml b/camlp4/top/rprint.ml
index 76f19fe11e..bfac0188d7 100644
--- a/camlp4/top/rprint.ml
+++ b/camlp4/top/rprint.ml
@@ -167,8 +167,8 @@ and print_simple_out_type ppf =
         | Ovar_name id tyl ->
             fprintf ppf "@[%a%a@]" print_typargs tyl print_ident id ]
       in
-      fprintf ppf "%s[|%s@[<hv>@[<hv>%a@]%a|]@]" (if non_gen then "_" else "")
-        (if closed then if tags = None then " " else "< "
+      fprintf ppf "%s[%s@[<hv>@[<hv>%a@]%a ]@]" (if non_gen then "_" else "")
+        (if closed then if tags = None then "= " else "< "
          else if tags = None then "> "
          else "? ")
         print_fields row_fields
@@ -313,12 +313,14 @@ and print_out_signature ppf =
         print_out_signature items ]
 and print_out_sig_item ppf =
   fun
-  [ Osig_class vir_flag name params clt ->
-      fprintf ppf "@[<2>class%s@ %a%s@ :@ %a@]"
+  [ Osig_class vir_flag name params clt rs ->
+      fprintf ppf "@[<2>%s%s@ %a%s@ :@ %a@]"
+        (if rs = Orec_next then "and" else "class")
         (if vir_flag then " virtual" else "") print_out_class_params params
         name Toploop.print_out_class_type.val clt
-  | Osig_class_type vir_flag name params clt ->
-      fprintf ppf "@[<2>class type%s@ %a%s@ =@ %a@]"
+  | Osig_class_type vir_flag name params clt rs ->
+      fprintf ppf "@[<2>%s%s@ %a%s@ =@ %a@]"
+        (if rs = Orec_next then "and" else "class type")
         (if vir_flag then " virtual" else "") print_out_class_params params
         name Toploop.print_out_class_type.val clt
   | Osig_exception id tyl ->
@@ -328,10 +330,16 @@ and print_out_sig_item ppf =
   | Osig_modtype name mty ->
       fprintf ppf "@[<2>module type %s =@ %a@]" name
         Toploop.print_out_module_type.val mty
-  | Osig_module name mty ->
-      fprintf ppf "@[<2>module %s :@ %a@]" name
+  | Osig_module name mty rs ->
+      fprintf ppf "@[<2>%s %s :@ %a@]" name
+        (match rs with [ Orec_not -> "module"
+                       | Orec_first -> "module rec"
+                       | Orec_next -> "and" ])
         Toploop.print_out_module_type.val mty
-  | Osig_type tdl -> print_out_type_decl_list ppf tdl
+  | Osig_type td rs ->
+      print_out_type_decl
+          (if rs = Orec_next then "and" else "type")
+          ppf td
   | Osig_value name ty prims ->
       let kwd = if prims = [] then "value" else "external" in
       let pr_prims ppf =
@@ -345,16 +353,7 @@ and print_out_sig_item ppf =
       in
       fprintf ppf "@[<2>%s %a :@ %a%a@]" kwd value_ident name
         Toploop.print_out_type.val ty pr_prims prims ]
-and print_out_type_decl_list ppf =
-  fun
-  [ [] -> ()
-  | [x] -> print_out_type_decl "type" ppf x
-  | [x :: l] ->
-      do {
-        print_out_type_decl "type" ppf x;
-        List.iter (fun x -> fprintf ppf "@ %a" (print_out_type_decl "and") x)
-          l
-      } ]
+
 and print_out_type_decl kwd ppf (name, args, ty, constraints) =
   let constrain ppf (ty, ty') =
     fprintf ppf "@ @[<2>constraint %a =@ %a@]" Toploop.print_out_type.val ty
diff --git a/config/Makefile-templ b/config/Makefile-templ
index d442a8c3e4..73180db018 100644
--- a/config/Makefile-templ
+++ b/config/Makefile-templ
@@ -261,12 +261,17 @@ OTHERLIBRARIES=unix str num threads graph dynlink labltk bigarray
 
 ### Name of the target architecture for the "num" library
 # Known targets:
-#       x86     68K     vax     ns      mips    alpha   pyramid i960
-#       sparc   supersparc      sparc-solaris   supersparc-solaris
-# See the file otherlibs/num/README for more explanations.
-# If you don't know, leave BIGNUM_ARCH=C, which selects a portable
+#	generic (portable C, works everywhere)
+#	ia32	(Intel x86)
+#	amd64	(AMD Opteron, Athlon64)
+#       alpha
+#	mips
+#	ppc	(Power PC)
+#	sparc
+# If you don't know, leave BNG_ARCH=generic, which selects a portable
 # C implementation of these routines.
-BIGNUM_ARCH=alpha
+BNG_ARCH=generic
+BNG_ASM_LEVEL=1
 
 ### Link-time options to ocamlc or ocamlopt for linking with POSIX threads
 # Needed for the "systhreads" package
diff --git a/config/Makefile.mingw b/config/Makefile.mingw
index b7b02a15f5..5f6a6767cf 100644
--- a/config/Makefile.mingw
+++ b/config/Makefile.mingw
@@ -108,7 +108,8 @@ BINUTILS_OBJCOPY=objcopy
 OTHERLIBRARIES=win32unix systhreads str num win32graph dynlink bigarray labltk
 
 ### Name of the target architecture for the "num" library
-BIGNUM_ARCH=C
+BNG_ARCH=ia32
+BNG_ASM_LEVEL=1
 
 ### Configuration for LablTk
 # Set TK_ROOT to the directory where you installed TCL/TK 8.3
diff --git a/config/Makefile.msvc b/config/Makefile.msvc
index 7144f9e01e..cf353a6692 100644
--- a/config/Makefile.msvc
+++ b/config/Makefile.msvc
@@ -108,7 +108,8 @@ BINUTILS_OBJCOPY=objcopy
 OTHERLIBRARIES=win32unix systhreads str num win32graph dynlink bigarray labltk
 
 ### Name of the target architecture for the "num" library
-BIGNUM_ARCH=C
+BNG_ARCH=generic
+BNG_ASM_LEVEL=0
 
 ### Configuration for LablTk
 # Set TK_ROOT to the directory where you installed TCL/TK 8.3
diff --git a/config/auto-aux/hasgot b/config/auto-aux/hasgot
index 99384768a9..5014b903d7 100755
--- a/config/auto-aux/hasgot
+++ b/config/auto-aux/hasgot
@@ -4,10 +4,11 @@ opts=""
 libs="$cclibs"
 args=$*
 rm -f hasgot.c
+var="x"
 while : ; do
   case "$1" in
     -i) echo "#include <$2>" >> hasgot.c; shift;;
-    -t) echo "$2 the_$2;" >> hasgot.c; shift;;
+    -t) echo "$2 $var;" >> hasgot.c; var="x$var"; shift;;
     -l*|-L*|-F*) libs="$libs $1";;
     -framework) libs="$libs $1 $2"; shift;;
     -*) opts="$opts $1";;
diff --git a/config/s-templ.h b/config/s-templ.h
index 8411ce41c9..bbbffb4fa3 100644
--- a/config/s-templ.h
+++ b/config/s-templ.h
@@ -47,10 +47,6 @@
    Also add the required libraries (e.g. -lcurses -ltermcap) to $(CCLIBS)
    in ../Makefile.config */
 
-#define HAS_STRERROR
-
-/* Define HAS_STRERROR if you have strerror(). */
-
 #define SUPPORT_DYNAMIC_LINKING
 
 /* Define SUPPORT_DYNAMIC_LINKING if dynamic loading of C stub code
diff --git a/configure b/configure
index 5570a3f7bc..b69c2e4093 100755
--- a/configure
+++ b/configure
@@ -39,7 +39,7 @@ verbose=no
 withcurses=yes
 withsharedlibs=yes
 binutils_dir=''
-gcc_warnings="-Wall -Wno-unused"
+gcc_warnings="-Wall"
 
 # Try to turn internationalization off, can cause config.guess to malfunction!
 unset LANG
@@ -405,8 +405,16 @@ case "$host" in
     # On Sparc V9 with certain versions of gcc, determination of double
     # alignment is not reliable (PR#1521), hence force it.
     # Same goes for hppa.
-    echo "Doubles must be doubleword-aligned."
-    echo "#define ARCH_ALIGN_DOUBLE" >> m.h;;
+    # But there's a knack (PR#2572):
+    # if we're in 64-bit mode (sizeof(long) == 8), 
+    # we must not doubleword-align floats...
+    if test $2 = 8; then
+      echo "Doubles can be word-aligned."
+      echo "#undef ARCH_ALIGN_DOUBLE" >> m.h
+    else
+      echo "Doubles must be doubleword-aligned."
+      echo "#define ARCH_ALIGN_DOUBLE" >> m.h
+    fi;;
   *)
     sh ./runtest dblalign.c
     case $? in
@@ -423,17 +431,28 @@ case "$host" in
 esac
 
 if $int64_native; then
-  sh ./runtest int64align.c
-  case $? in
-    0) echo "64-bit integers can be word-aligned."
-       echo "#undef ARCH_ALIGN_INT64" >> m.h;;
-    1) echo "64-bit integers must be doubleword-aligned."
-       echo "#define ARCH_ALIGN_INT64" >> m.h;;
-    *) echo "Something went wrong during alignment determination for 64-bit integers."
-       echo "I'm going to assume this architecture has alignment constraints."
-       echo "That's a safe bet: Objective Caml will work even if"
-       echo "this architecture has actually no alignment constraints."
-       echo "#define ARCH_ALIGN_INT64" >> m.h;;
+  case "$host" in
+    hppa*-*-*)
+      if test $2 = 8; then
+        echo "64-bit integers can be word-aligned."
+        echo "#undef ARCH_ALIGN_INT64" >> m.h
+      else
+        echo "64-bit integers must be doubleword-aligned."
+        echo "#define ARCH_ALIGN_INT64" >> m.h
+      fi;;
+    *)
+      sh ./runtest int64align.c
+      case $? in
+        0) echo "64-bit integers can be word-aligned."
+           echo "#undef ARCH_ALIGN_INT64" >> m.h;;
+        1) echo "64-bit integers must be doubleword-aligned."
+           echo "#define ARCH_ALIGN_INT64" >> m.h;;
+        *) echo "Something went wrong during alignment determination for 64-bit integers."
+           echo "I'm going to assume this architecture has alignment constraints."
+           echo "That's a safe bet: Objective Caml will work even if"
+           echo "this architecture has actually no alignment constraints."
+           echo "#define ARCH_ALIGN_INT64" >> m.h;;
+      esac
   esac
 else
   echo "#undef ARCH_ALIGN_INT64" >> m.h
@@ -471,13 +490,19 @@ if test $withsharedlibs = "yes"; then
       shared_libraries_supported=true;;
     alpha*-*-osf*)
       case "$bytecc" in
-        cc*) sharedcccompopts="";;
-        gcc*) sharedcccompopts="-fPIC";;
-      esac
-      mksharedlib="ld -shared -expect_unresolved '*' -o"
-      byteccrpath="-Wl,-rpath,"
-      mksharedlibrpath="-rpath "
-      shared_libraries_supported=true;;
+        gcc*)
+          sharedcccompopts="-fPIC"
+          mksharedlib="$bytecc -shared -o"
+          byteccrpath="-Wl,-rpath,"
+          mksharedlibrpath="-Wl,-rpath,"
+          shared_libraries_supported=true;;
+        cc*)
+          sharedcccompopts=""
+          mksharedlib="ld -shared -expect_unresolved '*' -o"
+          byteccrpath="-Wl,-rpath,"
+          mksharedlibrpath="-rpath "
+          shared_libraries_supported=true;;
+      esac;;
     *-*-solaris2*)
       case "$bytecc" in
         gcc*)
@@ -551,7 +576,7 @@ case "$host" in
   mips-*-irix6*)                arch=mips; system=irix;;
   hppa1.1-*-hpux*)              arch=hppa; system=hpux;;
   hppa2.0*-*-hpux*)             arch=hppa; system=hpux;;
-  hppa1.1-*-nextstep*)          arch=hppa; system=nextstep;;
+  hppa*-*-linux*)		arch=hppa; system=linux;;
   rs6000-*-aix*)                arch=power; model=rs6000; system=aix;;
   powerpc-*-aix*)               arch=power; model=ppc; system=aix;;
   powerpc-*-linux*)             arch=power; model=ppc; system=elf;;
@@ -561,8 +586,8 @@ case "$host" in
   arm*-*-linux*)                arch=arm; system=linux;;
   ia64-*-linux*)                arch=ia64; system=linux;;
   ia64-*-freebsd*)              arch=ia64; system=freebsd;;
-  amd64-*-freebsd*)             arch=amd64; system=freebsd;;
   x86_64-*-linux*)              arch=amd64; system=linux;;
+  x86_64-*-freebsd*)            arch=amd64; system=freebsd;;
 esac
 
 if test -z "$ccoption"; then
@@ -637,6 +662,7 @@ case "$arch,$model,$system" in
   sparc,*,solaris)
     profiling='prof'
     case "$nativecc" in gcc*) ;; *) cc_profile='-xpg';; esac;;
+  amd64,*,linux) profiling='prof';;
   *) profiling='noprof';;
 esac
 
@@ -732,11 +758,6 @@ fi
 
 # For the sys module
 
-if sh ./hasgot strerror; then
-  echo "strerror() found."
-  echo "#define HAS_STRERROR" >> s.h
-fi
-
 if sh ./hasgot times; then
   echo "times() found."
   echo "#define HAS_TIMES" >> s.h
@@ -783,6 +804,13 @@ if sh ./hasgot inet_aton; then
   echo "#define HAS_INET_ATON" >> s.h
 fi
 
+if sh ./hasgot -i sys/types.h -i sys/socket.h -i netinet/in.h \
+               -t 'struct sockaddr_in6' \
+&& sh ./hasgot getaddrinfo getnameinfo inet_pton inet_ntop; then
+  echo "IPv6 is supported."
+  echo "#define HAS_IPV6" >> s.h
+fi
+
 if sh ./hasgot -i unistd.h; then
   echo "unistd.h found."
   echo "#define HAS_UNISTD" >> s.h
diff --git a/debugger/.depend b/debugger/.depend
index dd7a517cc3..33eae2f14e 100644
--- a/debugger/.depend
+++ b/debugger/.depend
@@ -8,9 +8,10 @@ eval.cmi: debugcom.cmi ../typing/env.cmi ../typing/ident.cmi \
 events.cmi: ../bytecomp/instruct.cmi 
 frames.cmi: ../bytecomp/instruct.cmi primitives.cmi 
 input_handling.cmi: primitives.cmi 
+lexer.cmi: parser.cmi 
 loadprinter.cmi: ../otherlibs/dynlink/dynlink.cmi ../parsing/longident.cmi 
-parser.cmi: ../parsing/longident.cmi parser_aux.cmi 
 parser_aux.cmi: ../parsing/longident.cmi primitives.cmi 
+parser.cmi: ../parsing/longident.cmi parser_aux.cmi 
 pattern_matching.cmi: debugcom.cmi parser_aux.cmi ../typing/typedtree.cmi 
 pos.cmi: ../bytecomp/instruct.cmi 
 primitives.cmi: ../otherlibs/unix/unix.cmi 
@@ -32,21 +33,21 @@ checkpoints.cmx: debugcom.cmx int64ops.cmx primitives.cmx checkpoints.cmi
 command_line.cmo: breakpoints.cmi checkpoints.cmi ../utils/config.cmi \
     ../typing/ctype.cmi debugcom.cmi debugger_config.cmi envaux.cmi eval.cmi \
     events.cmi frames.cmi history.cmi input_handling.cmi \
-    ../bytecomp/instruct.cmi int64ops.cmi ../parsing/lexer.cmi \
-    loadprinter.cmi ../utils/misc.cmi parameters.cmi parser.cmi \
-    parser_aux.cmi pos.cmi primitives.cmi printval.cmi program_loading.cmi \
-    program_management.cmi show_information.cmi show_source.cmi source.cmi \
-    symbols.cmi time_travel.cmi ../typing/types.cmi \
-    ../otherlibs/unix/unix.cmi unix_tools.cmi command_line.cmi 
+    ../bytecomp/instruct.cmi int64ops.cmi lexer.cmi loadprinter.cmi \
+    ../utils/misc.cmi parameters.cmi parser.cmi parser_aux.cmi pos.cmi \
+    primitives.cmi printval.cmi program_loading.cmi program_management.cmi \
+    show_information.cmi show_source.cmi source.cmi symbols.cmi \
+    time_travel.cmi ../typing/types.cmi ../otherlibs/unix/unix.cmi \
+    unix_tools.cmi command_line.cmi 
 command_line.cmx: breakpoints.cmx checkpoints.cmx ../utils/config.cmx \
     ../typing/ctype.cmx debugcom.cmx debugger_config.cmx envaux.cmx eval.cmx \
     events.cmx frames.cmx history.cmx input_handling.cmx \
-    ../bytecomp/instruct.cmx int64ops.cmx ../parsing/lexer.cmx \
-    loadprinter.cmx ../utils/misc.cmx parameters.cmx parser.cmx \
-    parser_aux.cmi pos.cmx primitives.cmx printval.cmx program_loading.cmx \
-    program_management.cmx show_information.cmx show_source.cmx source.cmx \
-    symbols.cmx time_travel.cmx ../typing/types.cmx \
-    ../otherlibs/unix/unix.cmx unix_tools.cmx command_line.cmi 
+    ../bytecomp/instruct.cmx int64ops.cmx lexer.cmx loadprinter.cmx \
+    ../utils/misc.cmx parameters.cmx parser.cmx parser_aux.cmi pos.cmx \
+    primitives.cmx printval.cmx program_loading.cmx program_management.cmx \
+    show_information.cmx show_source.cmx source.cmx symbols.cmx \
+    time_travel.cmx ../typing/types.cmx ../otherlibs/unix/unix.cmx \
+    unix_tools.cmx command_line.cmi 
 debugcom.cmo: input_handling.cmi int64ops.cmi ../utils/misc.cmi \
     primitives.cmi debugcom.cmi 
 debugcom.cmx: input_handling.cmx int64ops.cmx ../utils/misc.cmx \
@@ -85,14 +86,14 @@ history.cmo: checkpoints.cmi debugger_config.cmi int64ops.cmi \
     ../utils/misc.cmi primitives.cmi history.cmi 
 history.cmx: checkpoints.cmx debugger_config.cmx int64ops.cmx \
     ../utils/misc.cmx primitives.cmx history.cmi 
-input_handling.cmo: ../parsing/lexer.cmi primitives.cmi \
-    ../otherlibs/unix/unix.cmi input_handling.cmi 
-input_handling.cmx: ../parsing/lexer.cmx primitives.cmx \
-    ../otherlibs/unix/unix.cmx input_handling.cmi 
+input_handling.cmo: lexer.cmi primitives.cmi ../otherlibs/unix/unix.cmi \
+    input_handling.cmi 
+input_handling.cmx: lexer.cmx primitives.cmx ../otherlibs/unix/unix.cmx \
+    input_handling.cmi 
 int64ops.cmo: int64ops.cmi 
 int64ops.cmx: int64ops.cmi 
-lexer.cmo: parser.cmi primitives.cmi 
-lexer.cmx: parser.cmx primitives.cmx 
+lexer.cmo: parser.cmi primitives.cmi lexer.cmi 
+lexer.cmx: parser.cmx primitives.cmx lexer.cmi 
 loadprinter.cmo: ../utils/config.cmi ../typing/ctype.cmi debugger_config.cmi \
     ../otherlibs/dynlink/dynlink.cmi ../typing/env.cmi ../typing/ident.cmi \
     ../parsing/longident.cmi ../utils/misc.cmi ../typing/path.cmi \
diff --git a/driver/compile.ml b/driver/compile.ml
index 52cf87d4a4..5f065ff818 100644
--- a/driver/compile.ml
+++ b/driver/compile.ml
@@ -50,10 +50,10 @@ let initial_env () =
 
 (* Compile a .mli file *)
 
-let interface ppf sourcefile =
+let interface ppf sourcefile outputprefix =
   init_path();
-  let prefixname = chop_extension_if_any sourcefile in
-  let modulename = String.capitalize(Filename.basename prefixname) in
+  let modulename =
+    String.capitalize(Filename.basename(chop_extension_if_any sourcefile)) in
   let inputfile = Pparse.preprocess sourcefile in
   try
     let ast =
@@ -65,7 +65,7 @@ let interface ppf sourcefile =
                                    (Typemod.simplify_signature sg);
     Warnings.check_fatal ();
     if not !Clflags.print_types then
-      Env.save_signature sg modulename (prefixname ^ ".cmi");
+      Env.save_signature sg modulename (outputprefix ^ ".cmi");
     Pparse.remove_preprocessed inputfile
   with e ->
     Pparse.remove_preprocessed_if_ast inputfile;
@@ -79,27 +79,27 @@ let print_if ppf flag printer arg =
 
 let (++) x f = f x
 
-let implementation ppf sourcefile =
+let implementation ppf sourcefile outputprefix =
   init_path();
-  let prefixname = chop_extension_if_any sourcefile in
-  let modulename = String.capitalize(Filename.basename prefixname) in
+  let modulename =
+    String.capitalize(Filename.basename(chop_extension_if_any sourcefile)) in
   let inputfile = Pparse.preprocess sourcefile in
   let env = initial_env() in
   if !Clflags.print_types then begin
     try ignore(
       Pparse.file ppf inputfile Parse.implementation ast_impl_magic_number
       ++ print_if ppf Clflags.dump_parsetree Printast.implementation
-      ++ Typemod.type_implementation sourcefile prefixname modulename env)
+      ++ Typemod.type_implementation sourcefile outputprefix modulename env)
     with x ->
       Pparse.remove_preprocessed_if_ast inputfile;
       raise x
   end else begin    
-    let objfile = prefixname ^ ".cmo" in
+    let objfile = outputprefix ^ ".cmo" in
     let oc = open_out_bin objfile in
     try
       Pparse.file ppf inputfile Parse.implementation ast_impl_magic_number
       ++ print_if ppf Clflags.dump_parsetree Printast.implementation
-      ++ Typemod.type_implementation sourcefile prefixname modulename env
+      ++ Typemod.type_implementation sourcefile outputprefix modulename env
       ++ Translmod.transl_implementation modulename
       ++ print_if ppf Clflags.dump_rawlambda Printlambda.lambda
       ++ Simplif.simplify_lambda
diff --git a/driver/compile.mli b/driver/compile.mli
index 2271d103e3..507d61bbd7 100644
--- a/driver/compile.mli
+++ b/driver/compile.mli
@@ -16,8 +16,8 @@
 
 open Format
 
-val interface: formatter -> string -> unit
-val implementation: formatter -> string -> unit
+val interface: formatter -> string -> string -> unit
+val implementation: formatter -> string -> string -> unit
 val c_file: string -> unit
 
 val initial_env: unit -> Env.t
diff --git a/driver/main.ml b/driver/main.ml
index 65d21ecea3..8e31daa4ad 100644
--- a/driver/main.ml
+++ b/driver/main.ml
@@ -15,24 +15,38 @@
 open Config
 open Clflags
 
+let output_prefix name =
+  let oname =
+    match !output_name with
+    | None -> name
+    | Some n -> if !compile_only then (output_name := None; n) else name in
+  Misc.chop_extension_if_any oname
+
 let process_interface_file ppf name =
-  Compile.interface ppf name
+  Compile.interface ppf name (output_prefix name)
 
 let process_implementation_file ppf name =
-  Compile.implementation ppf name;
-  objfiles := (Misc.chop_extension_if_any name ^ ".cmo") :: !objfiles
+  let opref = output_prefix name in
+  Compile.implementation ppf name opref;
+  objfiles := (opref ^ ".cmo") :: !objfiles
 
 let process_file ppf name =
   if Filename.check_suffix name ".ml"
   || Filename.check_suffix name ".mlt" then begin
-    Compile.implementation ppf name;
-    objfiles := (Misc.chop_extension_if_any name ^ ".cmo") :: !objfiles
+    let opref = output_prefix name in
+    Compile.implementation ppf name opref;
+    objfiles := (opref ^ ".cmo") :: !objfiles
+  end
+  else if Filename.check_suffix name !Config.interface_suffix then begin
+    let opref = output_prefix name in
+    Compile.interface ppf name opref;
+    if !make_package then objfiles := (opref ^ ".cmi") :: !objfiles
   end
-  else if Filename.check_suffix name !Config.interface_suffix then
-    Compile.interface ppf name
   else if Filename.check_suffix name ".cmo"
        || Filename.check_suffix name ".cma" then
     objfiles := name :: !objfiles
+  else if Filename.check_suffix name ".cmi" && !make_package then
+    objfiles := name :: !objfiles
   else if Filename.check_suffix name ext_obj
        || Filename.check_suffix name ext_lib then
     ccobjs := name :: !ccobjs
diff --git a/driver/optcompile.ml b/driver/optcompile.ml
index 0e52920f39..9d00bf8553 100644
--- a/driver/optcompile.ml
+++ b/driver/optcompile.ml
@@ -47,10 +47,10 @@ let initial_env () =
 
 (* Compile a .mli file *)
 
-let interface ppf sourcefile =
+let interface ppf sourcefile outputprefix =
   init_path();
-  let prefixname = Misc.chop_extension_if_any sourcefile in
-  let modulename = String.capitalize(Filename.basename prefixname) in
+  let modulename =
+    String.capitalize(Filename.basename(chop_extension_if_any sourcefile)) in
   let inputfile = Pparse.preprocess sourcefile in
   try
     let ast =
@@ -62,7 +62,7 @@ let interface ppf sourcefile =
                                    (Typemod.simplify_signature sg);
     Warnings.check_fatal ();
     if not !Clflags.print_types then
-      Env.save_signature sg modulename (prefixname ^ ".cmi");
+      Env.save_signature sg modulename (outputprefix ^ ".cmi");
     Pparse.remove_preprocessed inputfile
   with e ->
     Pparse.remove_preprocessed_if_ast inputfile;
@@ -77,10 +77,10 @@ let print_if ppf flag printer arg =
 let (++) x f = f x
 let (+++) (x, y) f = (x, f y)
 
-let implementation ppf sourcefile =
+let implementation ppf sourcefile outputprefix =
   init_path();
-  let prefixname = Misc.chop_extension_if_any sourcefile in
-  let modulename = String.capitalize(Filename.basename prefixname) in
+  let modulename =
+    String.capitalize(Filename.basename(chop_extension_if_any sourcefile)) in
   let inputfile = Pparse.preprocess sourcefile in
   let env = initial_env() in
   Compilenv.reset modulename;
@@ -88,17 +88,17 @@ let implementation ppf sourcefile =
     if !Clflags.print_types then ignore(
       Pparse.file ppf inputfile Parse.implementation ast_impl_magic_number
       ++ print_if ppf Clflags.dump_parsetree Printast.implementation
-      ++ Typemod.type_implementation sourcefile prefixname modulename env)
+      ++ Typemod.type_implementation sourcefile outputprefix modulename env)
     else begin
       Pparse.file ppf inputfile Parse.implementation ast_impl_magic_number
       ++ print_if ppf Clflags.dump_parsetree Printast.implementation
-      ++ Typemod.type_implementation sourcefile prefixname modulename env
+      ++ Typemod.type_implementation sourcefile outputprefix modulename env
       ++ Translmod.transl_store_implementation modulename
       +++ print_if ppf Clflags.dump_rawlambda Printlambda.lambda
       +++ Simplif.simplify_lambda
       +++ print_if ppf Clflags.dump_lambda Printlambda.lambda
-      ++ Asmgen.compile_implementation prefixname ppf;
-      Compilenv.save_unit_info (prefixname ^ ".cmx");
+      ++ Asmgen.compile_implementation outputprefix ppf;
+      Compilenv.save_unit_info (outputprefix ^ ".cmx");
     end;
     Warnings.check_fatal ();
     Pparse.remove_preprocessed inputfile
diff --git a/driver/optcompile.mli b/driver/optcompile.mli
index 2271d103e3..507d61bbd7 100644
--- a/driver/optcompile.mli
+++ b/driver/optcompile.mli
@@ -16,8 +16,8 @@
 
 open Format
 
-val interface: formatter -> string -> unit
-val implementation: formatter -> string -> unit
+val interface: formatter -> string -> string -> unit
+val implementation: formatter -> string -> string -> unit
 val c_file: string -> unit
 
 val initial_env: unit -> Env.t
diff --git a/driver/optmain.ml b/driver/optmain.ml
index 2afb45fa6d..9ff920603c 100644
--- a/driver/optmain.ml
+++ b/driver/optmain.ml
@@ -15,31 +15,45 @@
 open Config
 open Clflags
 
+let output_prefix name =
+  let oname =
+    match !output_name with
+    | None -> name
+    | Some n -> if !compile_only then (output_name := None; n) else name in
+  Misc.chop_extension_if_any oname
+
 let process_interface_file ppf name =
-  Optcompile.interface ppf name
+  Optcompile.interface ppf name (output_prefix name)
 
 let process_implementation_file ppf name =
-  Optcompile.implementation ppf name;
-  objfiles := (Misc.chop_extension_if_any name ^ ".cmx") :: !objfiles
+  let opref = output_prefix name in
+  Optcompile.implementation ppf name opref;
+  objfiles := (opref ^ ".cmx") :: !objfiles
 
 let process_file ppf name =
   if Filename.check_suffix name ".ml"
   || Filename.check_suffix name ".mlt" then begin
-    Optcompile.implementation ppf name;
-    objfiles := (Misc.chop_extension_if_any name ^ ".cmx") :: !objfiles
+    let opref = output_prefix name in
+    Optcompile.implementation ppf name opref;
+    objfiles := (opref ^ ".cmx") :: !objfiles
+  end
+  else if Filename.check_suffix name !Config.interface_suffix then begin
+    let opref = output_prefix name in
+    Optcompile.interface ppf name opref;
+    if !make_package then objfiles := (opref ^ ".cmi") :: !objfiles
   end
-  else if Filename.check_suffix name !Config.interface_suffix then
-    Optcompile.interface ppf name
   else if Filename.check_suffix name ".cmx" 
        || Filename.check_suffix name ".cmxa" then
     objfiles := name :: !objfiles
+  else if Filename.check_suffix name ".cmi" && !make_package then
+    objfiles := name :: !objfiles
   else if Filename.check_suffix name ext_obj
        || Filename.check_suffix name ext_lib then
     ccobjs := name :: !ccobjs
   else if Filename.check_suffix name ".c" then begin
     Optcompile.c_file name;
     ccobjs := (Filename.chop_suffix (Filename.basename name) ".c" ^ ext_obj)
-    :: !ccobjs
+              :: !ccobjs
   end
   else
     raise(Arg.Bad("don't know what to do with " ^ name))
diff --git a/driver/pparse.ml b/driver/pparse.ml
index da65a5525b..0622ddad9f 100644
--- a/driver/pparse.ml
+++ b/driver/pparse.ml
@@ -23,7 +23,9 @@ let preprocess sourcefile =
     None -> sourcefile
   | Some pp ->
       let tmpfile = Filename.temp_file "camlpp" "" in
-      let comm = Printf.sprintf "%s %s > %s" pp sourcefile tmpfile in
+      let comm = Printf.sprintf "%s %s > %s"
+                                pp (Filename.quote sourcefile) tmpfile
+      in
       if Ccomp.command comm <> 0 then begin
         Misc.remove_file tmpfile;
         raise Error;
diff --git a/emacs/caml-font.el b/emacs/caml-font.el
index 678b2a5020..628a757e5f 100644
--- a/emacs/caml-font.el
+++ b/emacs/caml-font.el
@@ -2,8 +2,9 @@
 
 (cond
  ((x-display-color-p)
+  (require 'font-lock)
   (cond
-   ((not (memq 'font-lock-type-face (face-list)))
+   ((not (boundp 'font-lock-type-face))
     ; make the necessary faces
     (make-face 'Firebrick)
     (set-face-foreground 'Firebrick "Firebrick")
diff --git a/gcamllib/Makefile b/gcamllib/Makefile
index fbdd5ed359..b7929145aa 100644
--- a/gcamllib/Makefile
+++ b/gcamllib/Makefile
@@ -24,7 +24,7 @@ CAMLOPT=$(RUNTIME) $(OPTCOMPILER)
 OPTCOMPFLAGS=-warn-error A -nostdlib -I ../stdlib -I ../toplevel -I ../typing
 CAMLDEP=../boot/ocamlrun ../tools/ocamldep
 
-OBJS=gcaml.cmo gcamltop.cmo safevio.cmo gprint.cmo
+OBJS=gcaml.cmo safevio.cmo gprint.cmo
 ALLOBJS=$(OBJS)
 
 all: gcamllib.cma
diff --git a/lex/cset.ml b/lex/cset.ml
index 84c2a77142..ec68ee1c8b 100644
--- a/lex/cset.ml
+++ b/lex/cset.ml
@@ -11,6 +11,11 @@
 (*                                                                     *)
 (***********************************************************************)
 
+(* $Id$ *)
+
+
+exception Bad
+
 type t = (int * int) list
 
 
diff --git a/lex/cset.mli b/lex/cset.mli
index 0ebcac0e5f..fc2c9930c3 100644
--- a/lex/cset.mli
+++ b/lex/cset.mli
@@ -11,13 +11,18 @@
 (*                                                                     *)
 (***********************************************************************)
 
+(* $Id$ *)
+
 (* Set of characters encoded as list of intervals *)
 
 type t 
+exception Bad
 
 val empty : t
 val is_empty : t -> bool
 val all_chars : t
+exception Bad
+
 val all_chars_eof : t
 val eof : t
 val singleton : int ->  t
diff --git a/lex/lexer.mli b/lex/lexer.mli
index 569a5b266f..be34674eb3 100644
--- a/lex/lexer.mli
+++ b/lex/lexer.mli
@@ -14,7 +14,9 @@
 
 val main: Lexing.lexbuf -> Parser.token
 
-exception Lexical_error of string * int * int
+exception Lexical_error of string * string * int * int
 
+(*n
 val line_num: int ref
 val line_start_pos: int ref
+*)
diff --git a/lex/lexer.mll b/lex/lexer.mll
index 5249ca8bc0..fa1d15bda6 100644
--- a/lex/lexer.mll
+++ b/lex/lexer.mll
@@ -25,7 +25,7 @@ and comment_depth = ref 0
 
 let in_pattern () = !brace_depth = 0 && !comment_depth = 0
 
-exception Lexical_error of string * int * int
+exception Lexical_error of string * string * int * int
 
 let string_buff = Buffer.create 256
 
@@ -42,24 +42,32 @@ let char_for_backslash = function
   | 'r' -> '\r'
   | c   -> c
 
-
-let line_num = ref 1
-let line_start_pos = ref 0
+let raise_lexical_error lexbuf msg =
+  let p = Lexing.lexeme_start_p lexbuf in
+  raise (Lexical_error (msg,
+                        p.Lexing.pos_fname,
+                        p.Lexing.pos_lnum,
+                        p.Lexing.pos_cnum - p.Lexing.pos_bol + 1))
+;;
 
 let handle_lexical_error fn lexbuf =
-  let line = !line_num
-  and column = Lexing.lexeme_start lexbuf - !line_start_pos + 1 in
+  let p = Lexing.lexeme_start_p lexbuf in
+  let line = p.Lexing.pos_lnum
+  and column = p.Lexing.pos_cnum - p.Lexing.pos_bol + 1
+  and file = p.Lexing.pos_fname
+  in
   try
     fn lexbuf
-  with Lexical_error (msg, 0, 0) ->
-    raise(Lexical_error(msg, line, column))
+  with Lexical_error (msg, "", 0, 0) ->
+    raise(Lexical_error(msg, file, line, column))
 
 let get_input_name () = Sys.argv.(Array.length Sys.argv - 1)
   
 let warning lexbuf msg =
+  let p = Lexing.lexeme_start_p lexbuf in
   Printf.eprintf "ocamllex warning:\nFile \"%s\", line %d, character %d: %s.\n"
-    (get_input_name ()) !line_num
-    (Lexing.lexeme_start lexbuf - !line_start_pos+1) msg;
+    p.Lexing.pos_fname p.Lexing.pos_lnum
+    (p.Lexing.pos_cnum - p.Lexing.pos_bol + 1) msg;
   flush stderr
 
 let decimal_code  c d u =
@@ -78,6 +86,27 @@ let char_for_hexadecimal_code d u =
   in
   Char.chr (val1 * 16 + val2)
 
+let incr_loc lexbuf delta =
+  let pos = lexbuf.Lexing.lex_curr_p in
+  lexbuf.Lexing.lex_curr_p <- { pos with
+    Lexing.pos_lnum = pos.Lexing.pos_lnum + 1;
+    Lexing.pos_bol = pos.Lexing.pos_cnum - delta;
+  }
+;;
+
+let update_loc lexbuf opt_file line =
+  let pos = lexbuf.Lexing.lex_curr_p in
+  let new_file = match opt_file with
+                 | None -> pos.Lexing.pos_fname
+                 | Some f -> f
+  in
+  lexbuf.Lexing.lex_curr_p <- { pos with
+    Lexing.pos_fname = new_file;
+    Lexing.pos_lnum = line;
+    Lexing.pos_bol = pos.Lexing.pos_cnum;
+  }
+;;
+
 }
 
 let identstart =
@@ -91,9 +120,14 @@ rule main = parse
     [' ' '\013' '\009' '\012' ] + 
     { main lexbuf }
   | '\010'
-    { line_start_pos := Lexing.lexeme_end lexbuf;
-      incr line_num;
+    { incr_loc lexbuf 0;
       main lexbuf }
+  | "#" [' ' '\t']* (['0'-'9']+ as num) [' ' '\t']*
+    ('\"' ([^ '\010' '\013' '\"']* as name) '\"')?
+    [^ '\010' '\013']* '\010'
+    { update_loc lexbuf name (int_of_string num);
+      main lexbuf
+    }
   | "(*" 
     { comment_depth := 1;
       handle_lexical_error comment lexbuf;
@@ -121,25 +155,22 @@ rule main = parse
   | "'" '\\' (['0'-'9'] as c) (['0'-'9'] as d) (['0'-'9'] as u)"'" 
     { let v = decimal_code c d u in
       if v > 255 then
-        raise
-          (Lexical_error
-            (Printf.sprintf "illegal escape sequence \\%c%c%c" c d u,
-            !line_num, Lexing.lexeme_start lexbuf - !line_start_pos+1))
+        raise_lexical_error lexbuf
+          (Printf.sprintf "illegal escape sequence \\%c%c%c" c d u)
       else
         Tchar v }
   | "'" '\\' 'x'
        (['0'-'9' 'a'-'f' 'A'-'F'] as d) (['0'-'9' 'a'-'f' 'A'-'F'] as u) "'"
        { Tchar(Char.code(char_for_hexadecimal_code d u)) }
   | "'" '\\' (_ as c)
-    { raise
-       (Lexical_error
-         (Printf.sprintf "illegal escape sequence \\%c" c,
-          !line_num, Lexing.lexeme_start lexbuf - !line_start_pos+1))
+    { raise_lexical_error lexbuf
+        (Printf.sprintf "illegal escape sequence \\%c" c)
     }
   | '{' 
-    { let n1 = Lexing.lexeme_end lexbuf
-      and l1 = !line_num
-      and s1 = !line_start_pos in
+    { let p = Lexing.lexeme_end_p lexbuf in
+      let n1 = p.Lexing.pos_cnum
+      and l1 = p.Lexing.pos_lnum
+      and s1 = p.Lexing.pos_bol in
       brace_depth := 1;
       let n2 = handle_lexical_error action lexbuf in
       Taction({start_pos = n1; end_pos = n2;
@@ -155,20 +186,20 @@ rule main = parse
   | ')'  { Trparen }
   | '^'  { Tcaret }
   | '-'  { Tdash }
+  | '#'  { Tsharp }
   | eof  { Tend }
   | _
-    { raise(Lexical_error
-             ("illegal character " ^ String.escaped(Lexing.lexeme lexbuf),
-              !line_num, Lexing.lexeme_start lexbuf - !line_start_pos+1)) }
+    { raise_lexical_error lexbuf
+        ("illegal character " ^ String.escaped(Lexing.lexeme lexbuf))
+    }
 
 
 (* String parsing comes from the compiler lexer *)
 and string = parse
     '"' 
     { () }
-   | '\\' ("\010" | "\013" | "\013\010") [' ' '\009'] *
-    { line_start_pos := Lexing.lexeme_end lexbuf;
-      incr line_num;
+   | '\\' ("\010" | "\013" | "\013\010") ([' ' '\009'] * as spaces)
+    { incr_loc lexbuf (String.length spaces);
       string lexbuf }
   | '\\' (backslash_escapes as c)
     { store_string_char(char_for_backslash c);
@@ -192,11 +223,10 @@ and string = parse
       store_string_char c ;
       string lexbuf }
   | eof 
-    { raise(Lexical_error("unterminated string", 0, 0)) }
+    { raise(Lexical_error("unterminated string", "", 0, 0)) }
   | '\010'
     { store_string_char '\010';
-      line_start_pos := Lexing.lexeme_end lexbuf;
-      incr line_num;
+      incr_loc lexbuf 0;
       string lexbuf }
   | _ as c
     { store_string_char c;
@@ -223,10 +253,9 @@ and comment = parse
     { skip_char lexbuf ;
       comment lexbuf }
   | eof 
-    { raise(Lexical_error("unterminated comment", 0, 0)) }
+    { raise(Lexical_error("unterminated comment", "", 0, 0)) }
   | '\010'
-    { line_start_pos := Lexing.lexeme_end lexbuf;
-      incr line_num;
+    { incr_loc lexbuf 0;
       comment lexbuf }
   | _ 
     { comment lexbuf }
@@ -251,18 +280,17 @@ and action = parse
       comment lexbuf;
       action lexbuf }
   | eof 
-    { raise (Lexical_error("unterminated action", 0, 0)) }
+    { raise (Lexical_error("unterminated action", "", 0, 0)) }
   | '\010'
-    { line_start_pos := Lexing.lexeme_end lexbuf;
-      incr line_num;
+    { incr_loc lexbuf 0;
       action lexbuf }
   | _ 
     { action lexbuf }
 
 and skip_char = parse
   | '\\'? '\010' "'"
-     { line_start_pos := Lexing.lexeme_end lexbuf;
-       incr line_num }
+     { incr_loc lexbuf 1;
+     }
   | [^ '\\' '\''] "'" (* regular character *)
 (* one character and numeric escape sequences *)
   | '\\' _ "'"
diff --git a/lex/lexgen.ml b/lex/lexgen.ml
index 050c00b4cc..8d665e77ee 100644
--- a/lex/lexgen.ml
+++ b/lex/lexgen.ml
@@ -155,7 +155,7 @@ let rec do_find_opt = function
       let opt1,all1 = do_find_opt e1
       and opt2,all2 = do_find_opt e2 in
       StringSet.union
-        (stringset_delta opt1 opt2)
+        (StringSet.union opt1 opt2)
         (stringset_delta all1 all2),
       StringSet.union all1 all2
   | Repetition e  ->
diff --git a/lex/main.ml b/lex/main.ml
index d97820151f..03b9ac91ef 100644
--- a/lex/main.ml
+++ b/lex/main.ml
@@ -55,6 +55,9 @@ let main () =
   let oc = open_out dest_name in
   let tr = Common.open_tracker dest_name oc in
   let lexbuf = Lexing.from_channel ic in
+  lexbuf.Lexing.lex_curr_p <-
+    {Lexing.pos_fname = source_name; Lexing.pos_lnum = 1;
+     Lexing.pos_bol = 0; Lexing.pos_cnum = 0};
   try
     let def = Parser.lexer_definition Lexer.main lexbuf in
     let (entries, transitions) = Lexgen.make_dfa def.entrypoints in
@@ -76,15 +79,22 @@ let main () =
     Common.close_tracker tr;
     Sys.remove dest_name;
     begin match exn with
-      Parsing.Parse_error ->
+    | Cset.Bad ->
+        let p = Lexing.lexeme_start_p lexbuf in
+        Printf.fprintf stderr
+          "File \"%s\", line %d, character %d: character set expected.\n"
+          p.Lexing.pos_fname p.Lexing.pos_lnum
+          (p.Lexing.pos_cnum - p.Lexing.pos_bol)
+    | Parsing.Parse_error ->
+        let p = Lexing.lexeme_start_p lexbuf in
         Printf.fprintf stderr
           "File \"%s\", line %d, character %d: syntax error.\n"
-          source_name !Lexer.line_num
-          (Lexing.lexeme_start lexbuf - !Lexer.line_start_pos)
-    | Lexer.Lexical_error(msg, line, col) ->
+          p.Lexing.pos_fname p.Lexing.pos_lnum
+          (p.Lexing.pos_cnum - p.Lexing.pos_bol)
+    | Lexer.Lexical_error(msg, file, line, col) ->
         Printf.fprintf stderr
           "File \"%s\", line %d, character %d: %s.\n"
-          source_name line col msg
+          file line col msg
     | Lexgen.Memory_overflow ->
         Printf.fprintf stderr
           "File \"%s\":\n Position memory overflow, too many bindings\n"
diff --git a/lex/parser.mly b/lex/parser.mly
index a1921309b2..8f6ff70525 100644
--- a/lex/parser.mly
+++ b/lex/parser.mly
@@ -40,6 +40,10 @@ let rec remove_as = function
   | Alternative (e1, e2) -> Alternative (remove_as e1, remove_as e2)
   | Repetition e -> Repetition (remove_as e)
 
+let as_cset = function
+  | Characters s -> s
+  | _ -> raise Cset.Bad
+
 %}
 
 %token <string> Tident
@@ -47,9 +51,10 @@ let rec remove_as = function
 %token <string> Tstring
 %token <Syntax.location> Taction
 %token Trule Tparse Tparse_shortest Tand Tequal Tend Tor Tunderscore Teof Tlbracket Trbracket
-%token Tstar Tmaybe Tplus Tlparen Trparen Tcaret Tdash Tlet Tas
+%token Tstar Tmaybe Tplus Tlparen Trparen Tcaret Tdash Tlet Tas Tsharp
 
 %right Tas
+%left Tsharp
 %left Tor
 %nonassoc CONCAT
 %nonassoc Tmaybe Tstar Tplus
@@ -131,6 +136,12 @@ regexp:
         { Alternative(Epsilon, $1) }
   | regexp Tplus
         { Sequence(Repetition (remove_as $1), $1) }
+  | regexp Tsharp regexp
+        {
+          let s1 = as_cset $1
+          and s2 = as_cset $3 in
+          Characters (Cset.diff s1 s2)
+        } 
   | regexp Tor regexp
         { Alternative($1,$3) }
   | regexp regexp %prec CONCAT
diff --git a/man/ocamlrun.m b/man/ocamlrun.m
index 0fff44d766..7db888bddf 100644
--- a/man/ocamlrun.m
+++ b/man/ocamlrun.m
@@ -21,7 +21,7 @@ command.
 The first non-option argument is taken to be the name of the file
 containing the executable bytecode. (That file is searched in the
 executable path as well as in the current directory.) The remaining
-arguments are passed to the Caml Light program, in the string array
+arguments are passed to the Objective Caml program, in the string array
 Sys.argv. Element 0 of this array is the name of the
 bytecode executable file; elements 1 to 
 .I n
@@ -62,6 +62,9 @@ A parameter specification is an option letter followed by an =
 sign, a decimal number, and an optional multiplier.  There are seven
 options:
 .TP
+.BR b \ (backtrace)
+Print a stack backtrace in case of an uncaught exception.
+.TP
 .BR s \ (minor_heap_size)
 Size of the minor heap.
 .TP
@@ -104,6 +107,12 @@ Change of GC parameters.
 .TP
 .BR 64
 Computation of major GC slice size.
+.TP
+.BR 128
+Calling of finalisation function.
+.TP
+.BR 256
+Startup messages.
 
 The multiplier is
 .B k
diff --git a/ocamldoc/.depend b/ocamldoc/.depend
index d3a3951da1..46b98481ef 100644
--- a/ocamldoc/.depend
+++ b/ocamldoc/.depend
@@ -56,11 +56,11 @@ odoc_config.cmo: ../utils/config.cmi odoc_config.cmi
 odoc_config.cmx: ../utils/config.cmx odoc_config.cmi 
 odoc_cross.cmo: odoc_class.cmo odoc_exception.cmo odoc_messages.cmo \
     odoc_misc.cmi odoc_module.cmo odoc_name.cmi odoc_parameter.cmo \
-    odoc_search.cmi odoc_type.cmo odoc_types.cmi odoc_value.cmo \
+    odoc_scan.cmo odoc_search.cmi odoc_type.cmo odoc_types.cmi odoc_value.cmo \
     odoc_cross.cmi 
 odoc_cross.cmx: odoc_class.cmx odoc_exception.cmx odoc_messages.cmx \
     odoc_misc.cmx odoc_module.cmx odoc_name.cmx odoc_parameter.cmx \
-    odoc_search.cmx odoc_type.cmx odoc_types.cmx odoc_value.cmx \
+    odoc_scan.cmx odoc_search.cmx odoc_type.cmx odoc_types.cmx odoc_value.cmx \
     odoc_cross.cmi 
 odoc_dag2html.cmo: odoc_info.cmi odoc_dag2html.cmi 
 odoc_dag2html.cmx: odoc_info.cmx odoc_dag2html.cmi 
@@ -104,8 +104,10 @@ odoc_lexer.cmo: odoc_args.cmi odoc_comments_global.cmi odoc_messages.cmo \
     odoc_parser.cmi 
 odoc_lexer.cmx: odoc_args.cmx odoc_comments_global.cmx odoc_messages.cmx \
     odoc_parser.cmx 
-odoc_man.cmo: odoc_info.cmi odoc_messages.cmo odoc_misc.cmi odoc_str.cmi 
-odoc_man.cmx: odoc_info.cmx odoc_messages.cmx odoc_misc.cmx odoc_str.cmx 
+odoc_man.cmo: odoc_info.cmi odoc_messages.cmo odoc_misc.cmi odoc_print.cmi \
+    odoc_str.cmi 
+odoc_man.cmx: odoc_info.cmx odoc_messages.cmx odoc_misc.cmx odoc_print.cmx \
+    odoc_str.cmx 
 odoc_merge.cmo: odoc_args.cmi odoc_class.cmo odoc_exception.cmo \
     odoc_messages.cmo odoc_module.cmo odoc_name.cmi odoc_parameter.cmo \
     odoc_type.cmo odoc_types.cmi odoc_value.cmo odoc_merge.cmi 
@@ -121,19 +123,17 @@ odoc_misc.cmx: ../typing/btype.cmx ../typing/ctype.cmx ../typing/ident.cmx \
     ../parsing/longident.cmx odoc_messages.cmx odoc_types.cmx \
     ../typing/path.cmx ../typing/types.cmx odoc_misc.cmi 
 odoc.cmo: ../utils/clflags.cmo ../utils/config.cmi ../utils/misc.cmi \
-    odoc_analyse.cmi odoc_args.cmi odoc_config.cmi odoc_crc.cmo odoc_dot.cmo \
+    odoc_analyse.cmi odoc_args.cmi odoc_config.cmi odoc_dot.cmo \
     odoc_global.cmi odoc_html.cmo odoc_info.cmi odoc_latex.cmo odoc_man.cmo \
     odoc_messages.cmo odoc_texi.cmo ../typing/typedtree.cmi 
 odoc.cmx: ../utils/clflags.cmx ../utils/config.cmx ../utils/misc.cmx \
-    odoc_analyse.cmx odoc_args.cmx odoc_config.cmx odoc_crc.cmx odoc_dot.cmx \
+    odoc_analyse.cmx odoc_args.cmx odoc_config.cmx odoc_dot.cmx \
     odoc_global.cmx odoc_html.cmx odoc_info.cmx odoc_latex.cmx odoc_man.cmx \
     odoc_messages.cmx odoc_texi.cmx ../typing/typedtree.cmx 
 odoc_module.cmo: odoc_class.cmo odoc_exception.cmo odoc_name.cmi \
-    odoc_parameter.cmo odoc_type.cmo odoc_types.cmi odoc_value.cmo \
-    ../typing/types.cmi 
+    odoc_type.cmo odoc_types.cmi odoc_value.cmo ../typing/types.cmi 
 odoc_module.cmx: odoc_class.cmx odoc_exception.cmx odoc_name.cmx \
-    odoc_parameter.cmx odoc_type.cmx odoc_types.cmx odoc_value.cmx \
-    ../typing/types.cmx 
+    odoc_type.cmx odoc_types.cmx odoc_value.cmx ../typing/types.cmx 
 odoc_name.cmo: ../typing/ident.cmi ../parsing/longident.cmi \
     ../typing/path.cmi odoc_name.cmi 
 odoc_name.cmx: ../typing/ident.cmx ../parsing/longident.cmx \
@@ -168,16 +168,16 @@ odoc_sig.cmo: ../parsing/asttypes.cmi ../typing/btype.cmi \
     ../parsing/location.cmi ../utils/misc.cmi odoc_args.cmi odoc_class.cmo \
     odoc_env.cmi odoc_exception.cmo odoc_global.cmi odoc_merge.cmi \
     odoc_messages.cmo odoc_misc.cmi odoc_module.cmo odoc_name.cmi \
-    odoc_parameter.cmo odoc_type.cmo odoc_types.cmi odoc_value.cmo \
-    ../parsing/parsetree.cmi ../typing/path.cmi ../typing/typedtree.cmi \
-    ../typing/types.cmi odoc_sig.cmi 
+    odoc_parameter.cmo odoc_print.cmi odoc_type.cmo odoc_types.cmi \
+    odoc_value.cmo ../parsing/parsetree.cmi ../typing/path.cmi \
+    ../typing/typedtree.cmi ../typing/types.cmi odoc_sig.cmi 
 odoc_sig.cmx: ../parsing/asttypes.cmi ../typing/btype.cmx \
     ../parsing/location.cmx ../utils/misc.cmx odoc_args.cmx odoc_class.cmx \
     odoc_env.cmx odoc_exception.cmx odoc_global.cmx odoc_merge.cmx \
     odoc_messages.cmx odoc_misc.cmx odoc_module.cmx odoc_name.cmx \
-    odoc_parameter.cmx odoc_type.cmx odoc_types.cmx odoc_value.cmx \
-    ../parsing/parsetree.cmi ../typing/path.cmx ../typing/typedtree.cmx \
-    ../typing/types.cmx odoc_sig.cmi 
+    odoc_parameter.cmx odoc_print.cmx odoc_type.cmx odoc_types.cmx \
+    odoc_value.cmx ../parsing/parsetree.cmi ../typing/path.cmx \
+    ../typing/typedtree.cmx ../typing/types.cmx odoc_sig.cmi 
 odoc_str.cmo: odoc_exception.cmo odoc_messages.cmo odoc_misc.cmi \
     odoc_name.cmi odoc_print.cmi odoc_type.cmo odoc_value.cmo \
     ../typing/printtyp.cmi ../typing/types.cmi odoc_str.cmi 
diff --git a/ocamldoc/Changes.txt b/ocamldoc/Changes.txt
index f1ba418fcb..1f9a41d05e 100644
--- a/ocamldoc/Changes.txt
+++ b/ocamldoc/Changes.txt
@@ -1,5 +1,38 @@
 Current :
-OK - add: new option -customdir
+OK - latex: style latex pour indenter dans les module kind et les class kind
+OK - latex: il manque la g�n�ration des param�tres de classe
+OK - parse des {!modules: } et {!indexlist}
+OK - gestion des Module_list et Index_list
+OK - no need to Dynlink.add_available_units any more
+OK - generate html from module_kind rather than from module_type
+OK   + same for classes and class types
+OK - add the kind to module parameters (the way the parameter was build in the parsetree)
+OK - fix: the generated ocamldoc.sty is more robust for paragraphs in
+     ocamldocdescription environment
+OK - fix: when generating separated files in latex, generate them in
+     the same directory than the main file, (the one specified by -o)
+OK - mod: one section per to module in latex output + improve latex output
+OK - mod: odoc_latex: use buffers instead of string concatenation
+OK - add: new ocamldoc man page, thanks to Samuel Mimram
+OK - fix: useless parenthesis around agruments of arguments of a type constructor in
+     type definitions, and aournd arguments of exceptions in exception definitions.
+OK - fix: blank lines in verbatim, latex, code pre, code and ele ref modes
+     are now accepted
+OK - fix: html generator: included module names were displayed with their simple
+     name rather than their fully qualified name
+OK - fix: use a formatter from a buffer rather Format.str_formatter in
+     Odoc_mist.sting_of_module_type, to avoid too much blanks
+OK - new module odoc_print, will work when Format.pp_print_flush is fixed
+OK - odoc_html: use buffers instead of string concatenation
+OK - odoc_man: use buffers instead of string concatenation
+OK - odoc_cross.ml: use hash tables modified on the fly to resolve 
+    (module | module type | exception) name aliases
+OK - odoc_html: replace some calls to Str. by specific functions on strings
+OK - odoc_cross.ml: use a Map to associate a complete name to
+    the known elements with this name, instead of searching each time
+    through the whole list of modules -> a gain of more than 90% in speed
+    for cross-referencing (Odoc_cross.associate)
+OK - fix: Odoc_name.cut printed a '(' instead of a '.' OK - add: new option -customdir
 OK - add: new option -i (to add a path to the directory where 
      to look for custom generators)
 OK - add: add odoc_config.ml{,i}
@@ -20,16 +53,13 @@ OK - add: field m_code for modules, to keep the code of top modules
 OK - fix: display "include Foo" instead of "include module Foo" in Latex, Man, Texi
 OK - fix: not display comments associated to include directives
 OK - fix: bad display of type parameters for class and class types
-- need to fix display of type parameters for inherited classes/class types
-OK - fix: html generator: included module names were displayed with their simple
-     name rather than their fully qualified name
-OK - fix: use a formatter from a buffer rather Format.str_formatter in
-     Odoc_mist.sting_of_module_type, to avoid too much blanks
-OK - new module odoc_print, will work when Format.pp_print_flush is fixed
-  - odoc_html: use buffers instead of string concatenation
-OK - odoc_man: use buffers instead of string concatenation
-  - odoc_latex: use buffers instead of string concatenation
 
+TODO:
+ - need to fix display of type parameters for inherited classes/class types
+ - latex: types variant polymorphes d�passent de la page quand ils sont trop longs
+ - ajout � la doc de Module_list et Index_list (utilis� dans le html seulement)
+ - ajout ds la doc: fichier de l'option -intro utilis� pour l'index en html
+ - utilisation nouvelles infos de Xavier: "d�but de rec", etc.
 
 ======
 
@@ -116,4 +146,4 @@ Rep-release 2 :
   their navigation bar (for example, mozilla 0.9.5 is compliant)
 - '{bone}' doesn't work any more ; a space is required as in '{b one}'.
   Same for {e, {i, and some others marks. Check the manual
-- bug fixes
\ No newline at end of file
+- bug fixes
diff --git a/ocamldoc/Makefile b/ocamldoc/Makefile
index e968beb514..77b93237e2 100644
--- a/ocamldoc/Makefile
+++ b/ocamldoc/Makefile
@@ -23,7 +23,6 @@ OCAMLLEX = $(CAMLRUN) ../boot/ocamllex
 OCAMLYACC= ../boot/ocamlyacc
 OCAMLLIB = $(LIBDIR)
 OCAMLBIN = $(BINDIR)
-EXTRAC_CRC = $(CAMLRUN) ../otherlibs/dynlink/extract_crc
 
 OCAMLPP=-pp './remove_DEBUG'
 
@@ -102,10 +101,10 @@ CMOFILES= odoc_config.cmo \
 	odoc_control.cmo\
 	odoc_inherit.cmo\
 	odoc_search.cmo\
+	odoc_scan.cmo\
 	odoc_cross.cmo\
 	odoc_dep.cmo\
 	odoc_analyse.cmo\
-	odoc_scan.cmo\
 	odoc_info.cmo
 
 
@@ -198,8 +197,8 @@ libopt: $(OCAMLDOC_LIBCMXA) $(OCAMLDOC_LIBCMI)
 debug: 
 	make OCAMLPP=""
 
-$(OCAMLDOC): $(EXECMOFILES) odoc_crc.cmo odoc.cmo
-	$(OCAMLC) -o $@ -linkall unix.cma str.cma dynlink.cma $(LINKFLAGS) $(OCAMLCMOFILES) $(EXECMOFILES) odoc_crc.cmo odoc.cmo
+$(OCAMLDOC): $(EXECMOFILES) odoc.cmo
+	$(OCAMLC) -o $@ -linkall unix.cma str.cma dynlink.cma $(LINKFLAGS) $(OCAMLCMOFILES) $(EXECMOFILES) odoc.cmo
 $(OCAMLDOC_OPT): $(EXECMXFILES) odoc_opt.cmx
 	$(OCAMLOPT) -o $@ unix.cmxa str.cmxa $(LINKFLAGS) $(OCAMLCMXFILES) $(EXECMXFILES) odoc_opt.cmx
 
@@ -210,34 +209,6 @@ $(OCAMLDOC_LIBCMXA): $(LIBCMXFILES)
 
 manpages: stdlib_man/Pervasives.3o
 
-odoc_crc.ml: $(CMIFILES)
-	$(EXTRAC_CRC) $(INCLUDES) \
-	Arg Arith_status Array Big_int Buffer Callback Char Digest Dynlink \
-	Filename Format Gc Genlex Hashtbl \
-	Lazy Lexing List Map Marshal Nat Nativeint \
-	Num Obj CamlinternalOO Outcometree Parsing Pervasives Printexc \
-	Printf Profiling Queue Random Ratio \
-	Set Sort Stack Std_exit Str Stream \
-	String Sys Topdirs Toploop Unix Weak \
-	Printast Ident Tbl Misc Config Clflags Warnings Ccomp \
-	Linenum Location Longident Syntaxerr Parser Lexer Parse \
-	Types Path Btype Predef Datarepr Subst Env Ctype Primitive \
-	Oprint Printtyp Includecore Typetexp Parmatch Typedtree Typecore \
-	Includeclass Typedecl Typeclass Mtype Includemod Typemod \
-	Lambda Typeopt Printlambda Switch Matching Translobj Translcore \
-	Bytesections Runtimedef Symtable Opcodes Bytelink Bytelibrarian \
-	Translclass Errors Main_args Asttypes Depend \
-	Odoc_global Odoc_args Odoc_info Odoc_messages Odoc_types \
-	Odoc_misc Odoc_text_parser Odoc_text_lexer \
-	Odoc_text Odoc_comments_global Odoc_parser \
-	Odoc_lexer Odoc_comments Odoc_name Odoc_parameter \
-	Odoc_value Odoc_type Odoc_exception Odoc_class \
-	Odoc_module Odoc_str Odoc_args Odoc_env \
-	Odoc_sig Odoc_ast Odoc_control Odoc_inherit \
-	Odoc_search Odoc_cross Odoc_merge Odoc_analyse \
-	Odoc_dag2html Odoc_ocamlhtml Odoc_html Odoc_to_text \
-	Odoc_latex_style Odoc_latex Odoc_man Odoc_texi Odoc_scan > $@
-
 # Parsers and lexers dependencies :
 ###################################
 odoc_text_parser.ml: odoc_text_parser.mly
@@ -285,7 +256,7 @@ install: dummy
 	if test -d $(INSTALL_LIBDIR); then : ; else $(MKDIR) $(INSTALL_LIBDIR); fi
 	if test -d $(INSTALL_CUSTOMDIR); then : ; else $(MKDIR) $(INSTALL_CUSTOMDIR); fi
 	$(CP) $(OCAMLDOC)$(EXE) $(INSTALL_BINDIR)/$(OCAMLDOC)$(EXE)
-	$(CP) ocamldoc.hva *.cmi $(GENERATORS) $(OCAMLDOC_LIBCMA) $(INSTALL_LIBDIR)
+	$(CP) ocamldoc.hva *.cmi $(OCAMLDOC_LIBCMA) $(INSTALL_LIBDIR)
 	$(CP) $(INSTALL_MLIS) $(INSTALL_CMIS) $(INSTALL_LIBDIR)
 	if test -d $(INSTALL_MANODIR); then : ; else $(MKDIR) $(INSTALL_MANODIR); fi
 	$(CP) stdlib_man/* $(INSTALL_MANODIR)
@@ -321,6 +292,15 @@ test_latex: dummy
 	$(MKDIR) $@ 
 	$(OCAMLDOC_RUN) -latex -sort -o $@/test.tex -d $@ $(INCLUDES) odoc*.ml odoc*.mli ../stdlib/*.mli ../otherlibs/unix/unix.mli
 
+test_latex_simple: dummy
+	$(MKDIR) $@ 
+	$(OCAMLDOC_RUN) -latex -sort -o $@/test.tex -d $@ $(INCLUDES) \
+	-latextitle 6,subsection -latextitle 7,subsubection \
+	../stdlib/hashtbl.mli \
+	../stdlib/arg.mli \
+	../otherlibs/unix/unix.mli \
+	../stdlib/map.mli
+
 test_man: dummy
 	$(MKDIR) $@ 
 	$(OCAMLDOC_RUN) -man -sort -d $@ $(INCLUDES) odoc*.ml odoc*.mli
@@ -351,7 +331,7 @@ clean:: dummy
 	@rm -f $(OCAMLDOC)$(EXE) $(OCAMLDOC_OPT) *.cma *.cmxa *.cmo *.cmi *.cmx *.a *.o
 	@rm -f odoc_parser.output odoc_text_parser.output
 	@rm -f odoc_lexer.ml odoc_text_lexer.ml odoc_see_lexer.ml odoc_ocamlhtml.ml
-	@rm -f odoc_parser.ml odoc_parser.mli odoc_text_parser.ml odoc_text_parser.mli odoc_crc.ml
+	@rm -f odoc_parser.ml odoc_parser.mli odoc_text_parser.ml odoc_text_parser.mli 
 	@rm -rf stdlib_man
 
 depend::
diff --git a/ocamldoc/Makefile.nt b/ocamldoc/Makefile.nt
index ad50ac90f8..3a5a4ba24f 100644
--- a/ocamldoc/Makefile.nt
+++ b/ocamldoc/Makefile.nt
@@ -21,7 +21,6 @@ OCAMLYACC=../boot/ocamlyacc
 
 OCAMLLIB = $(LIBDIR)
 OCAMLBIN = $(BINDIR)
-EXTRAC_CRC = $(CAMLRUN) ../otherlibs/dynlink/extract_crc
 
 OCAMLPP=-pp "grep -v DEBUG"
 
@@ -96,10 +95,10 @@ CMOFILES= odoc_config.cmo \
 	odoc_control.cmo\
 	odoc_inherit.cmo\
 	odoc_search.cmo\
+	odoc_scan.cmo\
 	odoc_cross.cmo\
 	odoc_dep.cmo\
 	odoc_analyse.cmo\
-	odoc_scan.cmo\
 	odoc_info.cmo
 
 
@@ -187,8 +186,8 @@ libopt: $(OCAMLDOC_LIBCMXA) $(OCAMLDOC_LIBCMI)
 debug: 
 	make OCAMLPP=""
 
-$(OCAMLDOC): $(EXECMOFILES) odoc_crc.cmo odoc.cmo
-	$(OCAMLC) -o $@ -linkall unix.cma str.cma dynlink.cma $(LINKFLAGS) $(OCAMLCMOFILES) $(EXECMOFILES) odoc_crc.cmo odoc.cmo
+$(OCAMLDOC): $(EXECMOFILES) odoc.cmo
+	$(OCAMLC) -o $@ -linkall unix.cma str.cma dynlink.cma $(LINKFLAGS) $(OCAMLCMOFILES) $(EXECMOFILES) odoc.cmo
 $(OCAMLDOC_OPT): $(EXECMXFILES) odoc_opt.cmx
 	$(OCAMLOPT) -o $@ unix.cmxa str.cmxa $(LINKFLAGS) $(OCAMLCMXFILES) $(EXECMXFILES) odoc_opt.cmx
 
@@ -197,81 +196,6 @@ $(OCAMLDOC_LIBCMA): $(LIBCMOFILES)
 $(OCAMLDOC_LIBCMXA): $(LIBCMXFILES)
 	$(OCAMLOPT) -a -o $@ $(LINKFLAGS) $(OCAMLCMXFILES) $(LIBCMXFILES)
 
-odoc_crc.ml: $(CMIFILES)
-	$(EXTRAC_CRC) $(INCLUDES)\
-	Arg Arith_status Array Big_int Buffer Callback Char Digest Dynlink \
-	Filename Format Gc Genlex Hashtbl \
-	Lazy Lexing List Map Marshal Nat Nativeint\
-	Num Obj CamlinternalOO Outcometree Parsing Pervasives Printexc\
-	Printf Profiling Queue Random Ratio\
-	Set Sort Stack Std_exit Str Stream\
-	String Sys Topdirs Toploop Unix Weak\
-	Printast \
-	Ident \
-	Tbl \
-	Misc \
-	Config \
-	Clflags \
-	Warnings \
-	Ccomp \
-	Linenum\
-	Location\
-	Longident \
-	Syntaxerr \
-	Parser \
-	Lexer \
-	Parse \
-	Types \
-	Path \
-	Btype \
-	Predef \
-	Datarepr \
-	Subst \
-	Env \
-	Ctype \
-	Primitive \
-	Oprint \
-	Printtyp \
-	Includecore \
-	Typetexp \
-	Parmatch \
-	Typedtree \
-	Typecore \
-	Includeclass \
-	Typedecl \
-	Typeclass \
-	Mtype \
-	Includemod \
-	Typemod \
-	Lambda \
-	Typeopt \
-	Printlambda \
-	Switch \
-	Matching \
-	Translobj \
-	Translcore \
-	Bytesections \
-	Runtimedef \
-	Symtable \
-	Opcodes \
-	Bytelink \
-	Bytelibrarian \
-	Translclass \
-	Errors \
-	Main_args \
-	Asttypes \
-	Depend \
-	Odoc_global Odoc_args Odoc_info Odoc_messages Odoc_types\
-	Odoc_misc Odoc_text_parser Odoc_text_lexer\
-	Odoc_text Odoc_comments_global Odoc_parser\
-	Odoc_lexer Odoc_comments Odoc_name Odoc_parameter\
-	Odoc_value Odoc_type Odoc_exception Odoc_class\
-	Odoc_module Odoc_str Odoc_args Odoc_env\
-	Odoc_sig Odoc_ast Odoc_control Odoc_inherit\
-	Odoc_search Odoc_cross Odoc_merge Odoc_analyse\
-	Odoc_dag2html Odoc_ocamlhtml Odoc_html Odoc_to_text \
-	Odoc_latex_style Odoc_latex Odoc_man Odoc_texi Odoc_scan > $@
-
 # generic rules :
 #################
 
@@ -310,7 +234,7 @@ install: dummy
 	$(MKDIR) -p $(INSTALL_BINDIR)
 	$(MKDIR) -p $(INSTALL_LIBDIR)
 	$(CP) $(OCAMLDOC) $(INSTALL_BINDIR)/$(OCAMLDOC).exe
-	$(CP) ocamldoc.hva *.cmi $(GENERATORS) $(OCAMLDOC_LIBCMA) $(INSTALL_LIBDIR)
+	$(CP) ocamldoc.hva *.cmi $(OCAMLDOC_LIBCMA) $(INSTALL_LIBDIR)
 	$(CP) $(INSTALL_MLIS) $(INSTALL_CMIS) $(INSTALL_LIBDIR)
 
 installopt:
@@ -332,7 +256,7 @@ clean:: dummy
 	@rm -f $(OCAMLDOC) $(OCAMLDOC_OPT) *.cma *.cmxa *.cmo *.cmi *.cmx *.$(A) *.$(O)
 	@rm -f odoc_parser.output odoc_text_parser.output
 	@rm -f odoc_lexer.ml odoc_text_lexer.ml odoc_see_lexer.ml odoc_ocamlhtml.ml
-	@rm -f odoc_parser.ml odoc_parser.mli odoc_text_parser.ml odoc_text_parser.mli odoc_crc.ml
+	@rm -f odoc_parser.ml odoc_parser.mli odoc_text_parser.ml odoc_text_parser.mli 
 
 depend::
 	rm -f .depend
diff --git a/ocamldoc/odoc.ml b/ocamldoc/odoc.ml
index b1b6477ef9..f4970bfd53 100644
--- a/ocamldoc/odoc.ml
+++ b/ocamldoc/odoc.ml
@@ -71,7 +71,6 @@ let _ =
       Dynlink.init ();
       Dynlink.allow_unsafe_modules true;
       try
-        Dynlink.add_available_units Odoc_crc.crc_unit_list ;
         let real_file = get_real_filename file in
         ignore(Dynlink.loadfile real_file)
       with
diff --git a/ocamldoc/odoc_ast.ml b/ocamldoc/odoc_ast.ml
index 054ab2038e..fda03a08d8 100644
--- a/ocamldoc/odoc_ast.ml
+++ b/ocamldoc/odoc_ast.ml
@@ -423,7 +423,7 @@ module Analyser =
            | l ->
                match l with
                  [] ->
-                   (* cas impossible, on l'a filtr avant *)
+                   (* cas impossible, on l'a filtr� avant *)
                    assert false
                | (pattern_param, exp) :: second_ele :: q ->
                    (* implicit pattern matching -> anonymous parameter *)
@@ -1162,6 +1162,8 @@ module Analyser =
           )
 
       | Parsetree.Pstr_recmodule mods ->
+	  (* A VOIR ICI ca merde avec /work/tmp/graph.ml: pas de lien avec les module type 
+	     dans les contraintes sur les modules *)
 	  let new_env =
             List.fold_left 
               (fun acc_env (name, _, mod_exp) ->
@@ -1383,11 +1385,23 @@ module Analyser =
       let complete_name = Name.concat current_module_name module_name in
       let pos_start = p_module_expr.Parsetree.pmod_loc.Location.loc_start.Lexing.pos_cnum in
       let pos_end = p_module_expr.Parsetree.pmod_loc.Location.loc_end.Lexing.pos_cnum in
-      let modtype = tt_module_expr.Typedtree.mod_type in
+      let modtype = 
+        (* A VOIR : Odoc_env.subst_module_type env  ? *)
+	tt_module_expr.Typedtree.mod_type 
+      in
+      let m_code_intf =
+	match p_module_expr.Parsetree.pmod_desc with
+	  Parsetree.Pmod_constraint (_, pmodule_type) ->
+	    let loc_start = pmodule_type.Parsetree.pmty_loc.Location.loc_start.Lexing.pos_cnum in
+            let loc_end = pmodule_type.Parsetree.pmty_loc.Location.loc_end.Lexing.pos_cnum in
+	    Some (get_string_of_file loc_start loc_end)
+	| _ ->
+	    None
+      in
       let m_base =
         {
           m_name = complete_name ;
-          m_type = tt_module_expr.Typedtree.mod_type ;
+          m_type = modtype ;
           m_info = comment_opt ;
           m_is_interface = false ;
           m_file = !file_name ;
@@ -1395,7 +1409,7 @@ module Analyser =
           m_loc = { loc_impl = Some (!file_name, pos_start) ; loc_inter = None } ;
           m_top_deps = [] ;
 	  m_code = None ; (* code is set by the caller, after the module is created *)
-	  m_code_intf = None ;
+	  m_code_intf = m_code_intf ;
       } 
       in
       match (p_module_expr.Parsetree.pmod_desc, tt_module_expr.Typedtree.mod_desc) with
@@ -1411,30 +1425,37 @@ module Analyser =
           let elements2 = replace_dummy_included_modules elements included_modules_from_tt in
           { m_base with m_kind = Module_struct elements2 }
 
-      | (Parsetree.Pmod_functor (_, _, p_module_expr2), 
+      | (Parsetree.Pmod_functor (_, pmodule_type, p_module_expr2), 
          Typedtree.Tmod_functor (ident, mtyp, tt_module_expr2)) ->
-          let param =
-            {
-              mp_name = Name.from_ident ident ;
-              mp_type = Odoc_env.subst_module_type env mtyp ;              
-            } 
-          in
-          let dummy_complete_name = Name.concat "__" param.mp_name in
-          let new_env = Odoc_env.add_module env dummy_complete_name in
-          let m_base2 = analyse_module 
-              new_env
-              current_module_name
-              module_name
-              None
-              p_module_expr2
-              tt_module_expr2
-          in
-          let kind = 
-            match m_base2.m_kind with
-              Module_functor (params, k) -> Module_functor (param :: params, m_base2.m_kind)
-            | k -> Module_functor ([param], k)
-          in
-          { m_base with m_kind = kind }
+	   let loc_start = pmodule_type.Parsetree.pmty_loc.Location.loc_start.Lexing.pos_cnum in
+           let loc_end = pmodule_type.Parsetree.pmty_loc.Location.loc_end.Lexing.pos_cnum in
+	   let mp_type_code = get_string_of_file loc_start loc_end in
+	   print_DEBUG (Printf.sprintf "mp_type_code=%s" mp_type_code);
+	   let mp_name = Name.from_ident ident in
+	   let mp_kind = Sig.analyse_module_type_kind env 
+	       current_module_name pmodule_type mtyp
+	   in
+           let param =
+             {
+               mp_name = mp_name ;
+               mp_type = Odoc_env.subst_module_type env mtyp ;
+	       mp_type_code = mp_type_code ;
+	       mp_kind = mp_kind ;
+             } 
+           in
+           let dummy_complete_name = (*Name.concat "__"*) param.mp_name in
+	   (* TODO: A VOIR CE __ *)
+           let new_env = Odoc_env.add_module env dummy_complete_name in
+           let m_base2 = analyse_module 
+               new_env
+               current_module_name
+               module_name
+               None
+               p_module_expr2
+               tt_module_expr2
+           in
+           let kind = m_base2.m_kind in
+           { m_base with m_kind = Module_functor (param, kind) }
 
       | (Parsetree.Pmod_apply (p_module_expr1, p_module_expr2), 
          Typedtree.Tmod_apply (tt_module_expr1, tt_module_expr2, _))
@@ -1463,6 +1484,8 @@ module Analyser =
 
       | (Parsetree.Pmod_constraint (p_module_expr2, p_modtype), 
          Typedtree.Tmod_constraint (tt_module_expr2, tt_modtype, _)) ->
+	  print_DEBUG ("Odoc_ast: case Parsetree.Pmod_constraint + Typedtree.Tmod_constraint "^module_name);
+
           (* we create the module with p_module_expr2 and tt_module_expr2 
              but we change its type according to the constraint. 
              A VOIR : est-ce que c'est bien ?
@@ -1482,7 +1505,7 @@ module Analyser =
           in
           { 
             m_base with
-            m_type = tt_modtype ; 
+            m_type = Odoc_env.subst_module_type env tt_modtype ; 
             m_kind = Module_constraint (m_base2.m_kind, 
                                         mtkind)
 
@@ -1497,11 +1520,16 @@ module Analyser =
 	    tt_modtype, _)
 	) ->
 	  (* needed for recursive modules *)
+
+	  print_DEBUG ("Odoc_ast: case Parsetree.Pmod_structure + Typedtree.Tmod_constraint "^module_name);
 	  let elements = analyse_structure env complete_name pos_start pos_end p_structure tt_structure in
           (* we must complete the included modules *)
           let included_modules_from_tt = tt_get_included_module_list tt_structure in
           let elements2 = replace_dummy_included_modules elements included_modules_from_tt in
-          { m_base with m_kind = Module_struct elements2 }
+          { m_base with 
+	    m_type = Odoc_env.subst_module_type env tt_modtype ;
+	    m_kind = Module_struct elements2 ;
+	  }
 
       | (parsetree, typedtree) ->
           let s_parse = 
@@ -1552,21 +1580,18 @@ module Analyser =
        let included_modules_from_tt = tt_get_included_module_list tree_structure in
        let elements2 = replace_dummy_included_modules elements included_modules_from_tt in
        let kind = Module_struct elements2 in
-       let m =
-         {
-           m_name = mod_name ;
-           m_type = Types.Tmty_signature [] ;
-           m_info = info_opt ;
-           m_is_interface = false ;
-           m_file = !file_name ;
-           m_kind = kind ;
-           m_loc = { loc_impl = Some (!file_name, 0) ; loc_inter = None } ;
-           m_top_deps = [] ;
-	   m_code = (if !Odoc_args.keep_code then Some !file else None) ;
-	   m_code_intf = None ;
-         } 
-       in
-       m
+       {
+         m_name = mod_name ;
+         m_type = Types.Tmty_signature [] ;
+         m_info = info_opt ;
+         m_is_interface = false ;
+         m_file = !file_name ;
+         m_kind = kind ;
+         m_loc = { loc_impl = Some (!file_name, 0) ; loc_inter = None } ;
+         m_top_deps = [] ;
+	 m_code = (if !Odoc_args.keep_code then Some !file else None) ;
+	 m_code_intf = None ;
+       } 
   end
 
 
diff --git a/ocamldoc/odoc_class.ml b/ocamldoc/odoc_class.ml
index aea0748bfb..803aa0ba98 100644
--- a/ocamldoc/odoc_class.ml
+++ b/ocamldoc/odoc_class.ml
@@ -36,7 +36,7 @@ and class_apply = {
     capp_name : Name.t ; (** The complete name of the applied class *)
     mutable capp_class : t_class option;  (** The associated t_class if we found it *)
     capp_params : Types.type_expr list; (** The type of expressions the class is applied to *)
-    capp_params_code : string list ; (** The code of these exprssions *)
+    capp_params_code : string list ; (** The code of these expressions *)
   } 
 
 and class_constr = {
diff --git a/ocamldoc/odoc_cross.ml b/ocamldoc/odoc_cross.ml
index 4134ea84b8..cbe949edee 100644
--- a/ocamldoc/odoc_cross.ml
+++ b/ocamldoc/odoc_cross.ml
@@ -68,139 +68,213 @@ module P_alias =
 (** The module used to get the aliased elements. *)
 module Search_alias = Odoc_search.Search (P_alias)
 
-let rec build_alias_list (acc_m, acc_mt, acc_ex) = function
-    [] ->
-      (acc_m, acc_mt, acc_ex)
-  | (Odoc_search.Res_module m) :: q ->
-      let new_acc_m = 
-        match m.m_kind with
-          Module_alias ma -> (m.m_name, ma.ma_name) :: acc_m
-        | _ -> acc_m
-      in
-      build_alias_list (new_acc_m, acc_mt, acc_ex) q
-  | (Odoc_search.Res_module_type mt) :: q ->
-      let new_acc_mt = 
-        match mt.mt_kind with
-          Some (Module_type_alias mta) -> (mt.mt_name, mta.mta_name) :: acc_mt
-        | _ -> acc_mt
-      in
-      build_alias_list (acc_m, new_acc_mt, acc_ex) q
-  | (Odoc_search.Res_exception e) :: q ->
-      let new_acc_ex = 
-        match e.ex_alias with
-          None -> acc_ex
-        | Some ea -> (e.ex_name, ea.ea_name) :: acc_ex
-      in
-      build_alias_list (acc_m, acc_mt, new_acc_ex) q
-  | _ :: q ->
-      build_alias_list (acc_m, acc_mt, acc_ex) q
-
-
+type alias_state =
+    Alias_resolved
+  | Alias_to_resolve
 
 (** Couples of module name aliases. *)
-let module_aliases = ref [] ;;
+let (module_aliases : (Name.t, Name.t * alias_state) Hashtbl.t) = Hashtbl.create 13 ;;
 
-(** Couples of module type name aliases. *)
-let module_type_aliases = ref [] ;;
+(** Couples of module or module type name aliases. *)
+let module_and_modtype_aliases = Hashtbl.create 13;;
 
 (** Couples of exception name aliases. *)
-let exception_aliases = ref [] ;;
+let exception_aliases = Hashtbl.create 13;;
 
-(** Retrieve the aliases for modules, module types and exceptions and put them in global variables. *)
+let rec build_alias_list = function
+    [] -> ()
+  | (Odoc_search.Res_module m) :: q ->
+      (
+       match m.m_kind with
+         Module_alias ma -> 
+	   Hashtbl.add module_aliases m.m_name (ma.ma_name, Alias_to_resolve);
+	   Hashtbl.add module_and_modtype_aliases m.m_name (ma.ma_name, Alias_to_resolve)
+       | _ -> ()
+      );
+      build_alias_list q
+  | (Odoc_search.Res_module_type mt) :: q ->
+      (
+       match mt.mt_kind with
+         Some (Module_type_alias mta) -> 
+	   Hashtbl.add module_and_modtype_aliases 
+	     mt.mt_name (mta.mta_name, Alias_to_resolve)
+       | _ -> ()
+      );
+      build_alias_list q
+  | (Odoc_search.Res_exception e) :: q ->
+      (
+       match e.ex_alias with
+         None -> ()
+       | Some ea -> 
+	   Hashtbl.add exception_aliases 
+	     e.ex_name (ea.ea_name,Alias_to_resolve)
+      );
+      build_alias_list q
+  | _ :: q ->
+      build_alias_list q
+
+(** Retrieve the aliases for modules, module types and exceptions 
+   and put them in global hash tables. *)
 let get_alias_names module_list =
-  let (alias_m, alias_mt, alias_ex) = 
-    build_alias_list
-      ([], [], []) 
-      (Search_alias.search module_list 0)
-  in
-  module_aliases := alias_m ;
-  module_type_aliases := alias_mt ;
-  exception_aliases := alias_ex 
+  Hashtbl.clear module_aliases;
+  Hashtbl.clear module_and_modtype_aliases;
+  Hashtbl.clear exception_aliases;
+  build_alias_list (Search_alias.search module_list 0)
   
+exception Found of string
+let name_alias =
+  let rec f t name =
+    try
+      match Hashtbl.find t name with
+	(s, Alias_resolved) -> s
+      |	(s, Alias_to_resolve) -> f t s
+    with
+      Not_found ->
+	try
+	  Hashtbl.iter
+	    (fun n2 (n3, _) ->
+	      if Name.prefix n2 name then
+		let ln2 = String.length n2 in
+		let s = n3^(String.sub name ln2 ((String.length name) - ln2)) in
+		raise (Found s)
+	    )
+	    t ;
+	  Hashtbl.replace t name (name, Alias_resolved);
+	  name
+	with
+	  Found s ->
+	    let s2 = f t s in
+	    Hashtbl.replace t s2 (s2, Alias_resolved);
+	    s2
+  in
+  fun name alias_tbl ->
+    f alias_tbl name
 
-(** The module with lookup predicates. *)
-module P_lookup = 
+
+module Map_ord =
   struct
-    type t = Name.t
-    let p_module m name = (Name.prefix m.m_name name, m.m_name = (Name.name_alias name !module_aliases))
-    let p_module_type mt name = (Name.prefix mt.mt_name name, mt.mt_name = (Name.name_alias name (!module_aliases @ !module_type_aliases)))
-    let p_class c name = (false, c.cl_name = (Name.name_alias name (!module_aliases @ !module_type_aliases)))
-    let p_class_type ct name = (false, ct.clt_name = (Name.name_alias name (!module_aliases @ !module_type_aliases)))
-    let p_value v name = false
-    let p_type t name = false
-    let p_exception e name = e.ex_name = (Name.name_alias name !exception_aliases)
-    let p_attribute a name = false
-    let p_method m name = false
-    let p_section s name = false
+    type t = string 
+    let compare = Pervasives.compare
   end
 
-(** The module used to search by a complete name.*)
-module Search_by_complete_name = Odoc_search.Search (P_lookup)
-
-let rec lookup_module module_list name =
-  let l = List.filter
-      (fun res ->
-        match res with
-          Odoc_search.Res_module _ -> true
-        | _ -> false
-      )
-      (Search_by_complete_name.search module_list name)
-  in
-  match l with
-    (Odoc_search.Res_module m) :: _ -> m
-  | _ -> raise Not_found
-
-let rec lookup_module_type module_list name =
-  let l = List.filter
-      (fun res ->
-        match res with
-          Odoc_search.Res_module_type _ -> true
-        | _ -> false
-      )
-      (Search_by_complete_name.search module_list name)
-  in
-  match l with
-    (Odoc_search.Res_module_type mt) :: _ -> mt
-  | _ -> raise Not_found
-
-let rec lookup_class module_list name =
-  let l = List.filter
-      (fun res ->
-        match res with
-          Odoc_search.Res_class _ -> true
-        | _ -> false
-      )
-      (Search_by_complete_name.search module_list name)
-  in
-  match l with
-    (Odoc_search.Res_class c) :: _ -> c
-  | _ -> raise Not_found
-
-let rec lookup_class_type module_list name =
-  let l = List.filter
-      (fun res ->
-        match res with
-          Odoc_search.Res_class_type _ -> true
-        | _ -> false
-      )
-      (Search_by_complete_name.search module_list name)
+module Ele_map = Map.Make (Map_ord)
+
+let known_elements = ref Ele_map.empty
+let add_known_element name k = 
+  try
+    let l = Ele_map.find name !known_elements in
+    let s = Ele_map.remove name !known_elements in
+    known_elements := Ele_map.add name (k::l) s
+  with
+    Not_found ->
+      known_elements := Ele_map.add name [k] !known_elements
+
+let get_known_elements name =
+  try Ele_map.find name !known_elements
+  with Not_found -> []
+
+let kind_name_exists kind =
+  let pred = 
+    match kind with
+      RK_module -> (fun e -> match e with Odoc_search.Res_module _ -> true | _ -> false)
+    | RK_module_type -> (fun e -> match e with Odoc_search.Res_module_type _ -> true | _ -> false)
+    | RK_class -> (fun e -> match e with Odoc_search.Res_class_type _ -> true | _ -> false)
+    | RK_class_type -> (fun e -> match e with Odoc_search.Res_class_type _ -> true | _ -> false)
+    | RK_value -> (fun e -> match e with Odoc_search.Res_value _ -> true | _ -> false)
+    | RK_type -> (fun e -> match e with Odoc_search.Res_type _ -> true | _ -> false)
+    | RK_exception -> (fun e -> match e with Odoc_search.Res_exception _ -> true | _ -> false)
+    | RK_attribute -> (fun e -> match e with Odoc_search.Res_attribute _ -> true | _ -> false)
+    | RK_method -> (fun e -> match e with Odoc_search.Res_method _ -> true | _ -> false)
+    | RK_section _ -> assert false
   in
-  match l with
-    (Odoc_search.Res_class_type ct) :: _ -> ct
-  | _ -> raise Not_found
-
-let rec lookup_exception module_list name =
-  let l = List.filter
-      (fun res ->
-        match res with
-          Odoc_search.Res_exception _ -> true
-        | _ -> false
-      )
-      (Search_by_complete_name.search module_list name)
-  in
-  match l with
-    (Odoc_search.Res_exception e) :: _ -> e
-  | _ -> raise Not_found
+  fun name ->
+    try List.exists pred (get_known_elements name)
+    with Not_found -> false
+
+let module_exists = kind_name_exists RK_module
+let module_type_exists = kind_name_exists RK_module_type
+let class_exists = kind_name_exists RK_class
+let class_type_exists = kind_name_exists RK_class_type
+let value_exists = kind_name_exists RK_value
+let type_exists = kind_name_exists RK_type
+let exception_exists = kind_name_exists RK_exception
+let attribute_exists = kind_name_exists RK_attribute
+let method_exists = kind_name_exists RK_method
+
+let lookup_module name =
+  match List.find
+      (fun k -> match k with Odoc_search.Res_module _ -> true | _ -> false) 
+      (get_known_elements name)
+  with
+  | Odoc_search.Res_module m -> m
+  | _ -> assert false
+
+let lookup_module_type name =
+  match List.find
+      (fun k -> match k with Odoc_search.Res_module_type _ -> true | _ -> false) 
+      (get_known_elements name)
+  with
+  | Odoc_search.Res_module_type m -> m
+  | _ -> assert false
+
+let lookup_class name =
+  match List.find
+      (fun k -> match k with Odoc_search.Res_class _ -> true | _ -> false) 
+      (get_known_elements name)
+  with
+  | Odoc_search.Res_class c -> c
+  | _ -> assert false
+
+let lookup_class_type name =
+  match List.find
+      (fun k -> match k with Odoc_search.Res_class_type _ -> true | _ -> false) 
+      (get_known_elements name)
+  with
+  | Odoc_search.Res_class_type c -> c
+  | _ -> assert false
+
+let lookup_exception name =
+  match List.find
+      (fun k -> match k with Odoc_search.Res_exception _ -> true | _ -> false) 
+      (get_known_elements name)
+  with
+  | Odoc_search.Res_exception e -> e
+  | _ -> assert false
+
+class scan =
+  object
+    inherit Odoc_scan.scanner
+    method scan_value v = 
+      add_known_element v.val_name (Odoc_search.Res_value v)
+    method scan_type t = 
+      add_known_element t.ty_name (Odoc_search.Res_type t)
+    method scan_exception e =
+      add_known_element e.ex_name (Odoc_search.Res_exception e)
+    method scan_attribute a =
+      add_known_element a.att_value.val_name
+	(Odoc_search.Res_attribute a)
+    method scan_method m =
+      add_known_element m.met_value.val_name
+	(Odoc_search.Res_method m)
+    method scan_class_pre c =
+      add_known_element c.cl_name (Odoc_search.Res_class c);
+      true
+    method scan_class_type_pre c =
+      add_known_element c.clt_name (Odoc_search.Res_class_type c);
+      true
+    method scan_module_pre m =
+      add_known_element m.m_name (Odoc_search.Res_module m);
+      true
+    method scan_module_type_pre m =
+      add_known_element m.mt_name (Odoc_search.Res_module_type m);
+      true
+
+  end
+
+let init_known_elements_map module_list =
+  let c = new scan in
+  c#scan_module_list module_list
+
 
 (** The type to describe the names not found. *)
 type not_found_name = 
@@ -230,9 +304,9 @@ let rec associate_in_module module_list (acc_b_modif, acc_incomplete_top_module_
              (acc_b, acc_inc, acc_names)
          | None ->
              let mmt_opt =
-               try Some (Mod (lookup_module module_list ma.ma_name))
+               try Some (Mod (lookup_module ma.ma_name))
                with Not_found ->
-                 try Some (Modtype (lookup_module_type module_list ma.ma_name))
+                 try Some (Modtype (lookup_module_type ma.ma_name))
                  with Not_found -> None
              in
              match mmt_opt with
@@ -293,7 +367,7 @@ and associate_in_module_type module_list (acc_b_modif, acc_incomplete_top_module
              (acc_b, acc_inc, acc_names)
          | None ->
              let mt_opt =
-               try Some (lookup_module_type module_list mta.mta_name)
+               try Some (lookup_module_type mta.mta_name)
                with Not_found -> None
              in
              match mt_opt with
@@ -324,9 +398,9 @@ and associate_in_module_element module_list m_name (acc_b_modif, acc_incomplete_
           Some _ -> (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found)
         | None ->
             let mmt_opt =
-              try Some (Mod (lookup_module module_list im.im_name))
+              try Some (Mod (lookup_module im.im_name))
               with Not_found ->
-                try Some (Modtype (lookup_module_type module_list im.im_name))
+                try Some (Modtype (lookup_module_type im.im_name))
                 with Not_found -> None
             in
             match mmt_opt with
@@ -356,7 +430,7 @@ and associate_in_module_element module_list m_name (acc_b_modif, acc_incomplete_
                 (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found)
             | None -> 
                 let ex_opt =
-                  try Some (lookup_exception module_list ea.ea_name)
+                  try Some (lookup_exception ea.ea_name)
                   with Not_found -> None
                 in
                 match ex_opt with
@@ -377,9 +451,9 @@ and associate_in_class module_list (acc_b_modif, acc_incomplete_top_module_names
           Some _ -> (acc_b2, acc_inc2, acc_names2)
         | None ->
             let cct_opt =
-              try Some (Cl (lookup_class module_list ic.ic_name))
+              try Some (Cl (lookup_class ic.ic_name))
               with Not_found ->
-                try Some (Cltype (lookup_class_type module_list ic.ic_name, []))
+                try Some (Cltype (lookup_class_type ic.ic_name, []))
                 with Not_found -> None
             in
             match cct_opt with
@@ -398,7 +472,7 @@ and associate_in_class module_list (acc_b_modif, acc_incomplete_top_module_names
            Some _ ->  (acc_b, acc_inc, acc_names)
          | None -> 
              let cl_opt =
-               try Some (lookup_class module_list capp.capp_name)
+               try Some (lookup_class capp.capp_name)
                with Not_found -> None
              in
              match cl_opt with
@@ -416,14 +490,14 @@ and associate_in_class module_list (acc_b_modif, acc_incomplete_top_module_names
            Some _ ->  (acc_b, acc_inc, acc_names)
          | None -> 
              let cl_opt =
-               try Some (lookup_class module_list cco.cco_name)
+               try Some (lookup_class cco.cco_name)
                with Not_found -> None
              in
              match cl_opt with
                None -> 
                  (
                   let clt_opt =
-                    try Some (lookup_class_type module_list cco.cco_name)
+                    try Some (lookup_class_type cco.cco_name)
                     with Not_found -> None
                   in
                   match clt_opt with
@@ -460,9 +534,9 @@ and associate_in_class_type module_list (acc_b_modif, acc_incomplete_top_module_
             Some _ -> (acc_b2, acc_inc2, acc_names2)
           | None ->
               let cct_opt =
-                try Some (Cltype (lookup_class_type module_list ic.ic_name, []))
+                try Some (Cltype (lookup_class_type ic.ic_name, []))
                 with Not_found ->
-                  try Some (Cl (lookup_class module_list ic.ic_name))
+                  try Some (Cl (lookup_class ic.ic_name))
                   with Not_found -> None
               in
               match cct_opt with
@@ -481,9 +555,9 @@ and associate_in_class_type module_list (acc_b_modif, acc_incomplete_top_module_
            Some _ ->  (acc_b, acc_inc, acc_names)
          | None -> 
              let cct_opt =
-               try Some (Cltype (lookup_class_type module_list cta.cta_name, []))
+               try Some (Cltype (lookup_class_type cta.cta_name, []))
                with Not_found -> 
-                 try Some (Cl (lookup_class module_list cta.cta_name))
+                 try Some (Cl (lookup_class cta.cta_name))
                  with Not_found -> None
              in
              match cct_opt with
@@ -504,97 +578,109 @@ let ao = Odoc_misc.apply_opt
 
 let rec assoc_comments_text_elements module_list t_ele =
   match t_ele with
-    | Raw _
-    | Code _
-    | CodePre _
-    | Latex _
-    | Verbatim _ -> t_ele
-    | Bold t -> Bold (assoc_comments_text module_list t)
-    | Italic t -> Italic (assoc_comments_text module_list t)
-    | Center t -> Center (assoc_comments_text module_list t)
-    | Left t -> Left (assoc_comments_text module_list t)
-    | Right t -> Right (assoc_comments_text module_list t)
-    | Emphasize t -> Emphasize (assoc_comments_text module_list t)
-    | List l -> List (List.map (assoc_comments_text module_list) l)
-    | Enum l -> Enum (List.map (assoc_comments_text module_list) l)
-    | Newline -> Newline
-    | Block t -> Block (assoc_comments_text module_list t)
-    | Superscript t -> Superscript (assoc_comments_text module_list t)
-    | Subscript t -> Subscript (assoc_comments_text module_list t)
-    | Title (n, l_opt, t) -> Title (n, l_opt, (assoc_comments_text module_list t))
-    | Link (s, t) -> Link (s, (assoc_comments_text module_list t))
-    | Ref (name, None) ->
-	(
-	 (* we look for the first element with this name *)
-         let re = Str.regexp ("^"^(Str.quote name)^"$") in
-         let res = Odoc_search.Search_by_name.search module_list re in
-         match res with
-           [] ->
-             Odoc_messages.pwarning (Odoc_messages.cross_element_not_found name);
-             t_ele
-         | ele :: _ ->
-             let kind = 
-               match ele with
-                 Odoc_search.Res_module _ -> RK_module
-               | Odoc_search.Res_module_type _ -> RK_module_type
-               | Odoc_search.Res_class _ -> RK_class
-               | Odoc_search.Res_class_type _ -> RK_class_type
-               | Odoc_search.Res_value _ -> RK_value
-               | Odoc_search.Res_type _ -> RK_type
-               | Odoc_search.Res_exception _ -> RK_exception
-               | Odoc_search.Res_attribute _ -> RK_attribute
-               | Odoc_search.Res_method _ -> RK_method
-               | Odoc_search.Res_section (_ ,t)-> RK_section t
-             in
-             add_verified (name, Some kind) ;
-	     Ref (name, Some kind)
-	)
-    | Ref (name, Some kind) -> 
-	let v = (name, Some kind) in
-	(** we just verify that we find an element of this kind with this name *)
-	let re = Str.regexp ("^"^(Str.quote name)^"$") in
-        let res = Odoc_search.Search_by_name.search module_list re in
-	if was_verified v then
-	  Ref (name, Some kind)
-	else
-	  match kind with
-	  | RK_section _ ->
-	      (
-	       try
-		 let t = Odoc_search.find_section module_list re in
-		 let v2 = (name, Some (RK_section t)) in
-		 add_verified v2 ;
-		 Ref (name, Some (RK_section t))
-	       with
-		 Not_found ->
-		   Odoc_messages.pwarning (Odoc_messages.cross_section_not_found name);
-		   Ref (name, None)
-	      )
-	  | _ ->
-	      let (f,f_mes) = 
-		match kind with
-		  RK_module -> Odoc_search.module_exists, Odoc_messages.cross_module_not_found
-		| RK_module_type -> Odoc_search.module_type_exists, Odoc_messages.cross_module_type_not_found
-		| RK_class -> Odoc_search.class_exists, Odoc_messages.cross_class_not_found
-		| RK_class_type -> Odoc_search.class_type_exists, Odoc_messages.cross_class_type_not_found
-		| RK_value -> Odoc_search.value_exists, Odoc_messages.cross_value_not_found
-		| RK_type -> Odoc_search.type_exists, Odoc_messages.cross_type_not_found
-		| RK_exception -> Odoc_search.exception_exists, Odoc_messages.cross_exception_not_found
-		| RK_attribute -> Odoc_search.attribute_exists, Odoc_messages.cross_attribute_not_found
-		| RK_method -> Odoc_search.method_exists, Odoc_messages.cross_method_not_found
-		| RK_section _ -> assert false
-	      in
-	      if f module_list re then
-		(
-		 add_verified v ;
-		 Ref (name, Some kind)
-		)
-	      else
-		(
-		 Odoc_messages.pwarning (f_mes name);
-		 Ref (name, None)
-		)
-	
+  | Raw _
+  | Code _
+  | CodePre _
+  | Latex _
+  | Verbatim _ -> t_ele
+  | Bold t -> Bold (assoc_comments_text module_list t)
+  | Italic t -> Italic (assoc_comments_text module_list t)
+  | Center t -> Center (assoc_comments_text module_list t)
+  | Left t -> Left (assoc_comments_text module_list t)
+  | Right t -> Right (assoc_comments_text module_list t)
+  | Emphasize t -> Emphasize (assoc_comments_text module_list t)
+  | List l -> List (List.map (assoc_comments_text module_list) l)
+  | Enum l -> Enum (List.map (assoc_comments_text module_list) l)
+  | Newline -> Newline
+  | Block t -> Block (assoc_comments_text module_list t)
+  | Superscript t -> Superscript (assoc_comments_text module_list t)
+  | Subscript t -> Subscript (assoc_comments_text module_list t)
+  | Title (n, l_opt, t) -> Title (n, l_opt, (assoc_comments_text module_list t))
+  | Link (s, t) -> Link (s, (assoc_comments_text module_list t))
+  | Ref (name, None) ->
+      (
+       match get_known_elements name with
+	 [] ->
+	   (
+	    try
+	      let re = Str.regexp ("^"^(Str.quote name)^"$") in
+	      let t = Odoc_search.find_section module_list re in
+	      let v2 = (name, Some (RK_section t)) in
+	      add_verified v2 ;
+	      Ref (name, Some (RK_section t))
+	    with
+	      Not_found ->
+		Odoc_messages.pwarning (Odoc_messages.cross_element_not_found name);
+		Ref (name, None)
+	   )
+       | ele :: _ ->
+	   (* we look for the first element with this name *)
+           let kind = 
+             match ele with
+               Odoc_search.Res_module _ -> RK_module
+             | Odoc_search.Res_module_type _ -> RK_module_type
+             | Odoc_search.Res_class _ -> RK_class
+             | Odoc_search.Res_class_type _ -> RK_class_type
+             | Odoc_search.Res_value _ -> RK_value
+             | Odoc_search.Res_type _ -> RK_type
+             | Odoc_search.Res_exception _ -> RK_exception
+             | Odoc_search.Res_attribute _ -> RK_attribute
+             | Odoc_search.Res_method _ -> RK_method
+             | Odoc_search.Res_section (_ ,t)-> assert false
+           in
+           add_verified (name, Some kind) ;
+	   Ref (name, Some kind)
+      )
+  | Ref (name, Some kind) -> 
+      (
+       let v = (name, Some kind) in
+       if was_verified v then
+	 Ref (name, Some kind)
+       else
+	 match kind with
+	 | RK_section _ ->
+	     (
+	       (** we just verify that we find an element of this kind with this name *)
+	      try
+		let re = Str.regexp ("^"^(Str.quote name)^"$") in
+		let t = Odoc_search.find_section module_list re in
+		let v2 = (name, Some (RK_section t)) in
+		add_verified v2 ;
+		Ref (name, Some (RK_section t))
+	      with
+		Not_found ->
+		  Odoc_messages.pwarning (Odoc_messages.cross_section_not_found name);
+		  Ref (name, None)
+	     )
+	 | _ ->
+	     let (f,f_mes) = 
+	       match kind with
+		 RK_module -> module_exists, Odoc_messages.cross_module_not_found
+	       | RK_module_type -> module_type_exists, Odoc_messages.cross_module_type_not_found
+	       | RK_class -> class_exists, Odoc_messages.cross_class_not_found
+	       | RK_class_type -> class_type_exists, Odoc_messages.cross_class_type_not_found
+	       | RK_value -> value_exists, Odoc_messages.cross_value_not_found
+	       | RK_type -> type_exists, Odoc_messages.cross_type_not_found
+	       | RK_exception -> exception_exists, Odoc_messages.cross_exception_not_found
+	       | RK_attribute -> attribute_exists, Odoc_messages.cross_attribute_not_found
+	       | RK_method -> method_exists, Odoc_messages.cross_method_not_found
+	       | RK_section _ -> assert false
+	     in
+	     if f name then
+	       (
+		add_verified v ;
+		Ref (name, Some kind)
+	       )
+	     else
+	       (
+		Odoc_messages.pwarning (f_mes name);
+		Ref (name, None)
+	       )
+      )
+  | Module_list l -> 
+      Module_list l
+  | Index_list ->
+      Index_list
 
 and assoc_comments_text module_list text =
   List.map (assoc_comments_text_elements module_list) text
@@ -762,6 +848,7 @@ let associate_type_of_elements_in_comments module_list =
 (** The function which performs all the cross referencing. *)
 let associate module_list =
   get_alias_names module_list ;
+  init_known_elements_map module_list;
   let rec remove_doubles acc = function
       [] -> acc
     | h :: q ->
@@ -781,7 +868,7 @@ let associate module_list =
       (* we may be able to associate something else *)
       iter remaining_modules
     else
-      (* nothing changed, we won' be able to associate any more *)
+      (* nothing changed, we won't be able to associate any more *)
       acc_names_not_found
   in
   let names_not_found = iter module_list in
@@ -808,8 +895,7 @@ let associate module_list =
   ) ;
 
   (* Find a type for each name of element which is referenced in comments. *)
-  let _ = associate_type_of_elements_in_comments module_list in
-  ()
+  ignore (associate_type_of_elements_in_comments module_list)
         
 
 (* eof $Id$ *)
diff --git a/ocamldoc/odoc_env.ml b/ocamldoc/odoc_env.ml
index ab0fff272b..252c4f0109 100644
--- a/ocamldoc/odoc_env.ml
+++ b/ocamldoc/odoc_env.ml
@@ -52,9 +52,9 @@ let rec add_signature env root ?rel signat =
   let f env item =
     match item with
       Types.Tsig_value (ident, _) -> { env with env_values = (rel_name ident, qualify ident) :: env.env_values }
-    | Types.Tsig_type (ident,_ ) -> { env with env_types = (rel_name ident, qualify ident) :: env.env_types }
+    | Types.Tsig_type (ident,_,_) -> { env with env_types = (rel_name ident, qualify ident) :: env.env_types }
     | Types.Tsig_exception (ident, _) -> { env with env_exceptions = (rel_name ident, qualify ident) :: env.env_exceptions }
-    | Types.Tsig_module (ident, modtype) -> 
+    | Types.Tsig_module (ident, modtype, _) -> 
         let env2 = 
           match modtype with (* A VOIR : le cas o� c'est un identificateur, dans ce cas on n'a pas de signature *)
             Types.Tmty_signature s -> add_signature env (qualify ident) ~rel: (rel_name ident) s
@@ -73,8 +73,8 @@ let rec add_signature env root ?rel signat =
               |  _ -> env
         in
         { env2 with env_module_types = (rel_name ident, qualify ident) :: env2.env_module_types }
-    | Types.Tsig_class (ident, _) -> { env with env_classes = (rel_name ident, qualify ident) :: env.env_classes }
-    | Types.Tsig_cltype (ident, _) -> { env with env_class_types = (rel_name ident, qualify ident) :: env.env_class_types }
+    | Types.Tsig_class (ident, _, _) -> { env with env_classes = (rel_name ident, qualify ident) :: env.env_classes }
+    | Types.Tsig_cltype (ident, _, _) -> { env with env_class_types = (rel_name ident, qualify ident) :: env.env_class_types }
   in
   List.fold_left f env signat 
 
diff --git a/ocamldoc/odoc_html.ml b/ocamldoc/odoc_html.ml
index ffaf4cf2de..cbba5228f6 100644
--- a/ocamldoc/odoc_html.ml
+++ b/ocamldoc/odoc_html.ml
@@ -169,6 +169,8 @@ module Naming =
       f
   end
 
+module StringSet = Set.Make (struct type t = string let compare = compare end)
+
 (** A class with a method to colorize a string which represents OCaml code. *)
 class ocaml_code =
   object(self)
@@ -182,7 +184,7 @@ let bs = Buffer.add_string
 
 
 (** Generation of html code from text structures. *)
-class text =
+class virtual text =
   object (self)
     (** We want to display colorized code. *)
     inherit ocaml_code 
@@ -244,6 +246,8 @@ class text =
       | Odoc_info.Ref (name, ref_opt) -> self#html_of_Ref b name ref_opt
       | Odoc_info.Superscript t -> self#html_of_Superscript b t
       | Odoc_info.Subscript t -> self#html_of_Subscript b t
+      |	Odoc_info.Module_list l -> self#html_of_Module_list b l
+      |	Odoc_info.Index_list -> self#html_of_Index_list b
 
     method html_of_Raw b s = bs b (self#escape s)
 
@@ -356,7 +360,7 @@ class text =
     method html_of_Link b s t =
       bs b "<a href=\"";
       bs b s ;
-      bs b ">";
+      bs b "\">";
       self#html_of_text b t;
       bs b "</a>"
 
@@ -396,6 +400,65 @@ class text =
       self#html_of_text b t;
       bs b "</sub>"
 
+    method html_of_Module_list b l =
+      bs b "<br>\n<table class=\"indextable\">\n";
+      List.iter
+        (fun name ->
+	  bs b "<tr><td>";
+	  (
+	   try
+	     let m = 
+	       List.find (fun m -> m.m_name = name) self#list_modules 
+	     in
+	     let (html, _) = Naming.html_files m.m_name in
+	     bp b "<a href=\"%s\">%s</a></td>" html m.m_name;
+	     bs b "<td>";
+	     self#html_of_info_first_sentence b m.m_info;
+	   with
+	     Not_found ->
+	       Odoc_messages.pwarning (Odoc_messages.cross_module_not_found name);
+	       bp b "%s</td><td>" name
+	  );
+	  bs b "</td></tr>\n"
+	)
+        l;
+      bs b "</table>\n</body>\n</html>";
+
+    method html_of_Index_list b =
+      let index_if_not_empty l url m =
+        match l with
+          [] -> ()
+        | _ -> bp b "<a href=\"%s\">%s</a><br>\n" url m
+      in
+      index_if_not_empty self#list_types self#index_types Odoc_messages.index_of_types;
+      index_if_not_empty self#list_exceptions self#index_exceptions Odoc_messages.index_of_exceptions;
+      index_if_not_empty self#list_values self#index_values Odoc_messages.index_of_values;
+      index_if_not_empty self#list_attributes self#index_attributes Odoc_messages.index_of_attributes;
+      index_if_not_empty self#list_methods self#index_methods Odoc_messages.index_of_methods;
+      index_if_not_empty self#list_classes self#index_classes Odoc_messages.index_of_classes;
+      index_if_not_empty self#list_class_types self#index_class_types Odoc_messages.index_of_class_types;
+      index_if_not_empty self#list_modules self#index_modules Odoc_messages.index_of_modules;
+      index_if_not_empty self#list_module_types self#index_module_types Odoc_messages.index_of_module_types
+
+    method virtual list_types : Odoc_info.Type.t_type list
+    method virtual index_types : string
+    method virtual list_exceptions : Odoc_info.Exception.t_exception list
+    method virtual index_exceptions : string
+    method virtual list_values : Odoc_info.Value.t_value list
+    method virtual index_values : string
+    method virtual list_attributes : Odoc_info.Value.t_attribute list
+    method virtual index_attributes : string
+    method virtual list_methods : Odoc_info.Value.t_method list
+    method virtual index_methods : string
+    method virtual list_classes : Odoc_info.Class.t_class list
+    method virtual index_classes : string
+    method virtual list_class_types : Odoc_info.Class.t_class_type list
+    method virtual index_class_types : string
+    method virtual list_modules : Odoc_info.Module.t_module list
+    method virtual index_modules : string
+    method virtual list_module_types : Odoc_info.Module.t_module_type list
+    method virtual index_module_types : string
+
   end
 
 (** A class used to generate html code for info structures. *)
@@ -504,14 +567,17 @@ class virtual info =
         )
         l
 
-    (** Print html code for a description, except for the [i_params] field. *)
-    method html_of_info b info_opt =
+    (** Print html code for a description, except for the [i_params] field. 
+       @param indent can be specified not to use the style of info comments;
+       default is [true].
+    *)
+    method html_of_info ?(indent=true) b info_opt =
       match info_opt with
         None ->
           ()
       | Some info ->
           let module M = Odoc_info in
-          bs b "<div class=\"info\">\n";
+          if indent then bs b "<div class=\"info\">\n";
           (
 	   match info.M.i_deprecated with
             None -> ()
@@ -535,7 +601,7 @@ class virtual info =
           self#html_of_return_opt b info.M.i_return_value;
           self#html_of_sees b info.M.i_sees;
           self#html_of_custom b info.M.i_custom;
-          bs b "</div>\n"
+          if indent then bs b "</div>\n"
 
     (** Print html code for the first sentence of a description. 
        The titles and lists in this first sentence has been removed.*)
@@ -577,6 +643,25 @@ let print_concat b sep f =
   in
   iter
 
+let newline_to_indented_br s =
+  let len = String.length s in
+  let b = Buffer.create len in
+  for i = 0 to len - 1 do
+    match s.[i] with
+      '\n' -> Buffer.add_string b "<br>     "
+    | c -> Buffer.add_char b c
+  done;
+  Buffer.contents b
+
+let remove_last_newline s =
+  let len = String.length s in
+  if len <= 0 then
+    s
+  else
+    match s.[len-1] with
+      '\n' -> String.sub s 0 (len-1)
+    | _ -> s
+
 (** This class is used to create objects which can generate a simple html documentation. *)
 class html =
   object (self)
@@ -649,6 +734,8 @@ class html =
         "tr { background-color : White }" ;
 	"td.typefieldcomment { background-color : #FFFFFF }" ;
 	"pre { margin-bottom: 4px }" ;
+
+	"div.sig_block {margin-left: 2em}" ;
       ] 
       
     (** The style file for all pages. *)
@@ -660,58 +747,67 @@ class html =
     (** The known types names. 
        Used to know if we must create a link to a type
        when printing a type. *)
-    val mutable known_types_names = []
+    val mutable known_types_names = StringSet.empty
 
     (** The known class and class type names. 
        Used to know if we must create a link to a class 
        or class type or not when printing a type. *)
-    val mutable known_classes_names = []
+    val mutable known_classes_names = StringSet.empty
 
     (** The known modules and module types names. 
        Used to know if we must create a link to a type or not
        when printing a module type. *)
-    val mutable known_modules_names = []
+    val mutable known_modules_names = StringSet.empty
 
     (** The main file. *)
-    val mutable index = "index.html"
+    method index = "index.html"
     (** The file for the index of values. *)
-    val mutable index_values = "index_values.html"
+    method index_values = "index_values.html"
     (** The file for the index of types. *)
-    val mutable index_types = "index_types.html"
+    method index_types = "index_types.html"
     (** The file for the index of exceptions. *)
-    val mutable index_exceptions = "index_exceptions.html"
+    method index_exceptions = "index_exceptions.html"
     (** The file for the index of attributes. *)
-    val mutable index_attributes = "index_attributes.html"
+    method index_attributes = "index_attributes.html"
     (** The file for the index of methods. *)
-    val mutable index_methods = "index_methods.html"
+    method index_methods = "index_methods.html"
     (** The file for the index of classes. *)
-    val mutable index_classes = "index_classes.html"
+    method index_classes = "index_classes.html"
     (** The file for the index of class types. *)
-    val mutable index_class_types = "index_class_types.html"
+    method index_class_types = "index_class_types.html"
     (** The file for the index of modules. *)
-    val mutable index_modules = "index_modules.html"
+    method index_modules = "index_modules.html"
     (** The file for the index of module types. *)
-    val mutable index_module_types = "index_module_types.html"
+    method index_module_types = "index_module_types.html"
 
 
     (** The list of attributes. Filled in the [generate] method. *)
     val mutable list_attributes = []
+    method list_attributes = list_attributes
     (** The list of methods. Filled in the [generate] method. *)
     val mutable list_methods = []
+    method list_methods = list_methods
     (** The list of values. Filled in the [generate] method. *)
     val mutable list_values = []
+    method list_values = list_values
     (** The list of exceptions. Filled in the [generate] method. *)
     val mutable list_exceptions = []
+    method list_exceptions = list_exceptions
     (** The list of types. Filled in the [generate] method. *)
     val mutable list_types = []
+    method list_types = list_types
     (** The list of modules. Filled in the [generate] method. *)
     val mutable list_modules = []
+    method list_modules = list_modules
     (** The list of module types. Filled in the [generate] method. *)
     val mutable list_module_types = []
+    method list_module_types = list_module_types
     (** The list of classes. Filled in the [generate] method. *)
     val mutable list_classes = []
+    method list_classes = list_classes
     (** The list of class types. Filled in the [generate] method. *)
     val mutable list_class_types = []
+    method list_class_types = list_class_types
 
     (** The header of pages. Must be prepared by the [prepare_header] method.*)
     val mutable header = fun b -> fun ?(nav=None) -> fun ?(comments=[]) -> fun _ -> ()
@@ -767,7 +863,7 @@ class html =
         bs b "<head>\n";
 	bs b style;
         bs b "<link rel=\"Start\" href=\"";
-	bs b index;
+	bs b self#index;
 	bs b "\">\n" ;
         (
          match nav with
@@ -787,19 +883,19 @@ class html =
              );
              (
               let father = Name.father name in
-              let href = if father = "" then index else fst (Naming.html_files father) in
+              let href = if father = "" then self#index else fst (Naming.html_files father) in
               bp b "<link rel=\"Up\" href=\"%s\">\n" href
              )
         );
-        link_if_not_empty list_types Odoc_messages.index_of_types index_types;
-        link_if_not_empty list_exceptions Odoc_messages.index_of_exceptions index_exceptions;
-        link_if_not_empty list_values Odoc_messages.index_of_values index_values;
-        link_if_not_empty list_attributes Odoc_messages.index_of_attributes index_attributes;
-        link_if_not_empty list_methods Odoc_messages.index_of_methods index_methods;
-        link_if_not_empty list_classes Odoc_messages.index_of_classes index_classes;
-        link_if_not_empty list_class_types Odoc_messages.index_of_class_types index_class_types;
-        link_if_not_empty list_modules Odoc_messages.index_of_modules index_modules;
-        link_if_not_empty list_module_types Odoc_messages.index_of_module_types index_module_types;
+        link_if_not_empty self#list_types Odoc_messages.index_of_types self#index_types;
+        link_if_not_empty self#list_exceptions Odoc_messages.index_of_exceptions self#index_exceptions;
+        link_if_not_empty self#list_values Odoc_messages.index_of_values self#index_values;
+        link_if_not_empty self#list_attributes Odoc_messages.index_of_attributes self#index_attributes;
+        link_if_not_empty self#list_methods Odoc_messages.index_of_methods self#index_methods;
+        link_if_not_empty self#list_classes Odoc_messages.index_of_classes self#index_classes;
+        link_if_not_empty self#list_class_types Odoc_messages.index_of_class_types self#index_class_types;
+        link_if_not_empty self#list_modules Odoc_messages.index_of_modules self#index_modules;
+        link_if_not_empty self#list_module_types Odoc_messages.index_of_module_types self#index_module_types;
 	let print_one m =
 	  let html_file = fst (Naming.html_files m.m_name) in
           bp b "<link title=\"%s\" rel=\"Chapter\" href=\"%s\">"
@@ -854,6 +950,7 @@ class html =
       print_lines "Section" section_titles ;
       print_lines "Subsection" subsection_titles 
 
+
     (** Html code for navigation bar. 
        @param pre optional name for optional previous module/class 
        @param post optional name for optional next module/class
@@ -870,7 +967,7 @@ class html =
       );
       bs b "&nbsp;";
       let father = Name.father name in
-      let href = if father = "" then index else fst (Naming.html_files father) in
+      let href = if father = "" then self#index else fst (Naming.html_files father) in
       bp b "<a href=\"%s\">%s</a>\n" href Odoc_messages.up;
       bs b "&nbsp;";
       (
@@ -919,12 +1016,12 @@ class html =
             match_s
             rel
         in
-        if List.mem match_s known_types_names then
+        if StringSet.mem match_s known_types_names then
            "<a href=\""^(Naming.complete_target Naming.mark_type match_s)^"\">"^
            s_final^
            "</a>"
         else
-          if List.mem match_s known_classes_names then
+          if StringSet.mem match_s known_classes_names then
             let (html_file, _) = Naming.html_files match_s in
             "<a href=\""^html_file^"\">"^s_final^"</a>"
           else
@@ -942,11 +1039,17 @@ class html =
     method create_fully_qualified_module_idents_links m_name s =
       let f str_t = 
         let match_s = Str.matched_string str_t in
-        if List.mem match_s known_modules_names then
+	let rel = Name.get_relative m_name match_s in
+	let s_final = Odoc_info.apply_if_equal 
+            Odoc_info.use_hidden_modules 
+            match_s
+            rel
+        in
+        if StringSet.mem match_s known_modules_names then
           let (html_file, _) = Naming.html_files match_s in
-          "<a href=\""^html_file^"\">"^(Name.get_relative m_name match_s)^"</a>"
+          "<a href=\""^html_file^"\">"^s_final^"</a>"
         else
-          match_s
+          s_final
       in
       let s2 = Str.global_substitute
           (Str.regexp "\\([A-Z]\\([a-zA-Z_'0-9]\\)*\\.\\)+\\([A-Z][a-zA-Z_'0-9]*\\)")
@@ -957,30 +1060,18 @@ class html =
 
     (** Print html code to display a [Types.type_expr]. *)
     method html_of_type_expr b m_name t =
-      let s = String.concat "\n"
-          (Str.split (Str.regexp "\n") (Odoc_info.string_of_type_expr t))
-      in
-      let s2 = Str.global_replace (Str.regexp "\n") "<br>     " s in
-      bs b "<code class=\"type\">";
-      bs b (self#create_fully_qualified_idents_links m_name s2);
-      bs b "</code>"
-
-    (** Print html code to display a [Types.class_type].*)
-    method html_of_class_type_expr b m_name t =
-      let s = String.concat "\n"
-          (Str.split (Str.regexp "\n") (Odoc_info.string_of_class_type t))
-      in
-      let s2 = Str.global_replace (Str.regexp "\n") "<br>     " s in
+      let s = remove_last_newline (Odoc_info.string_of_type_expr t) in
+      let s2 = newline_to_indented_br s in
       bs b "<code class=\"type\">";
       bs b (self#create_fully_qualified_idents_links m_name s2);
       bs b "</code>"
 
     (** Print html code to display a [Types.type_expr list]. *)
-    method html_of_type_expr_list b m_name sep l =
+    method html_of_type_expr_list ?par b m_name sep l =
       print_DEBUG "html#html_of_type_expr_list";
-      let s = Odoc_info.string_of_type_list sep l in
+      let s = Odoc_info.string_of_type_list ?par sep l in
       print_DEBUG "html#html_of_type_expr_list: 1";
-      let s2 = Str.global_replace (Str.regexp "\n") "<br>     " s in
+      let s2 = newline_to_indented_br s in
       print_DEBUG "html#html_of_type_expr_list: 2";
       bs b "<code class=\"type\">";
       bs b (self#create_fully_qualified_idents_links m_name s2);
@@ -990,43 +1081,149 @@ class html =
        of a class of class type. *)
     method html_of_class_type_param_expr_list b m_name l =
       let s = Odoc_info.string_of_class_type_param_list l in
-      let s2 = Str.global_replace (Str.regexp "\n") "<br>       " s in
-      bs b "<code class=\"type\">";
+      let s2 = newline_to_indented_br s in
+      bs b "<code class=\"type\">[";
       bs b (self#create_fully_qualified_idents_links m_name s2);
-      bs b "</code>"
+      bs b "]</code>"
 
     (** Print html code to display a list of type parameters for the given type.*)
     method html_of_type_expr_param_list b m_name t =
       let s = Odoc_info.string_of_type_param_list t in
-      let s2 = Str.global_replace (Str.regexp "\n") "<br>     " s in
+      let s2 = newline_to_indented_br s in
       bs b "<code class=\"type\">";
       bs b (self#create_fully_qualified_idents_links m_name s2);
       bs b "</code>"
 
     (** Print html code to display a [Types.module_type]. *)
-    method html_of_module_type b m_name t =
-      let s = String.concat "\n"
-          (Str.split (Str.regexp "\n") (Odoc_info.string_of_module_type t))
-      in
+    method html_of_module_type b ?code m_name t =
+      let s = remove_last_newline (Odoc_info.string_of_module_type ?code t) in
       bs b "<code class=\"type\">";
       bs b (self#create_fully_qualified_module_idents_links m_name s);
       bs b "</code>"
-        
+
+    (** Print html code to display the given module kind. *)
+    method html_of_module_kind b father ?modu kind =
+      match kind with
+	Module_struct eles ->
+	  self#html_of_text b [Code "sig"];
+	  (
+	   match modu with
+	     None -> 
+	       bs b "<div class=\"sig_block\">";
+	       List.iter (self#html_of_module_element b father) eles;
+	       bs b "</div>"
+	   | Some m ->
+	       let (html_file, _) = Naming.html_files m.m_name in
+	       bp b " <a href=\"%s\">..</a> " html_file
+	  );
+	  self#html_of_text b [Code "end"]
+      | Module_alias a ->
+	  bs b "<code class=\"type\">";
+	  bs b (self#create_fully_qualified_module_idents_links father a.ma_name);
+	  bs b "</code>"
+      | Module_functor (p, k) ->
+	  bs b "<div class=\"sig_block\">";
+	  self#html_of_module_parameter b father p;
+	  self#html_of_module_kind b father ?modu k;
+	  bs b "</div>"
+      | Module_apply (k1, k2) ->
+	  (* TODO: l'application n'est pas correcte dans un .mli. 
+	     Que faire ? -> afficher le module_type du typedtree  *)
+	  self#html_of_module_kind b father k1;
+	  self#html_of_text b [Code "("];
+	  self#html_of_module_kind b father k2;
+	  self#html_of_text b [Code ")"]
+      | Module_with (k, s) ->
+	  (* TODO: � modifier quand Module_with sera plus d�taill� *)
+	  self#html_of_module_type_kind b father ?modu k;
+	  bs b "<code class=\"type\"> ";
+	  bs b (self#create_fully_qualified_module_idents_links father s);
+	  bs b "</code>"
+      | Module_constraint (k, tk) ->
+	  (* TODO: on affiche quoi ? *)
+	  self#html_of_module_kind b father ?modu k
+
+    method html_of_module_parameter b father p =
+      self#html_of_text b
+	[
+	  Code "functor (";
+	  Code p.mp_name ;
+	  Code " : ";
+	] ;
+      self#html_of_module_type_kind b father p.mp_kind;
+      self#html_of_text b [ Code ") -> "]
+
+    method html_of_module_element b father ele =
+      match ele with
+        Element_module m ->
+          self#html_of_module b ~complete: false m
+      | Element_module_type mt ->
+          self#html_of_modtype b ~complete: false mt
+      | Element_included_module im ->
+          self#html_of_included_module b im
+      | Element_class c ->
+          self#html_of_class b ~complete: false c
+      | Element_class_type ct ->
+          self#html_of_class_type b ~complete: false ct
+      | Element_value v ->
+          self#html_of_value b v
+      | Element_exception e ->
+          self#html_of_exception b e
+      | Element_type t ->
+          self#html_of_type b t
+      | Element_module_comment text ->
+          self#html_of_module_comment b text
+
+    (** Print html code to display the given module type kind. *)
+    method html_of_module_type_kind b father ?modu ?mt kind =
+      match kind with
+	Module_type_struct eles ->
+	  self#html_of_text b [Code "sig"];
+	  (
+	   match mt with
+	     None ->
+	       (
+		match modu with
+		  None ->
+		    bs b "<div class=\"sig_block\">";
+		    List.iter (self#html_of_module_element b father) eles;
+		    bs b "</div>"
+		| Some m ->
+		    let (html_file, _) = Naming.html_files m.m_name in
+		    bp b " <a href=\"%s\">..</a> " html_file
+	       )
+	   | Some mt ->
+	       let (html_file, _) = Naming.html_files mt.mt_name in
+	       bp b " <a href=\"%s\">..</a> " html_file
+	  );
+	  self#html_of_text b [Code "end"]
+      | Module_type_functor (p, k) ->
+	  self#html_of_module_parameter b father p;
+	  self#html_of_module_type_kind b father ?modu ?mt k
+      | Module_type_alias a ->
+	  bs b "<code class=\"type\">";
+	  bs b (self#create_fully_qualified_module_idents_links father a.mta_name);
+	  bs b "</code>"	  
+      | Module_type_with (k, s) ->
+	  self#html_of_module_type_kind b father ?modu ?mt k;
+	  bs b "<code class=\"type\"> ";
+	  bs b (self#create_fully_qualified_module_idents_links father s);
+	  bs b "</code>"
+
+    (** Print html code to display the type of a module parameter.. *)
+    method html_of_module_parameter_type b m_name p =
+      self#html_of_module_type b m_name ~code: p.mp_type_code p.mp_type
+
     (** Generate a file containing the module type in the given file name. *)
     method output_module_type in_title file mtyp =
-      let s = String.concat "\n"
-          (Str.split (Str.regexp "\n") (Odoc_info.string_of_module_type ~complete: true mtyp))
-      in
+      let s = remove_last_newline (Odoc_info.string_of_module_type ~complete: true mtyp) in
       self#output_code in_title file s
 
     (** Generate a file containing the class type in the given file name. *)
     method output_class_type in_title file ctyp =
-      let s = String.concat "\n"
-          (Str.split (Str.regexp "\n") (Odoc_info.string_of_class_type ~complete: true ctyp))
-      in
+      let s = remove_last_newline(Odoc_info.string_of_class_type ~complete: true ctyp) in
       self#output_code in_title file s
 
-
     (** Print html code for a value. *)
     method html_of_value b v =
       Odoc_info.reset_type_names ();
@@ -1069,7 +1266,8 @@ class html =
          [] -> ()
        | _ -> 
            bs b (" "^(self#keyword "of")^" ");
-           self#html_of_type_expr_list b (Name.father e.ex_name) " * " e.ex_args
+           self#html_of_type_expr_list 
+	     ~par: false b (Name.father e.ex_name) " * " e.ex_args
       );
       (
        match e.ex_alias with
@@ -1137,7 +1335,7 @@ class html =
                [] -> ()
              | l -> 
 		 bs b (" " ^ (self#keyword "of") ^ " ");
-		 self#html_of_type_expr_list b father " * " l;
+		 self#html_of_type_expr_list ~par: false b father " * " l;
             );
             bs b "</code></td>\n";
             (
@@ -1365,7 +1563,7 @@ class html =
               bs b "</code></td>\n" ;
               bs b "<td align=\"center\" valign=\"top\">:</td>\n";
               bs b "<td>" ;
-	      self#html_of_module_type b m_name p.mp_type;
+	      self#html_of_module_parameter_type b m_name p;
 	      bs b "\n";
               (
 	       match desc_opt with
@@ -1392,12 +1590,12 @@ class html =
          bs b (Name.simple m.m_name)
       );
       bs b ": ";
-      self#html_of_module_type b father m.m_type;
+      self#html_of_module_kind b father ~modu: m m.m_kind;
       bs b "</pre>";
       if info then
         (
 	 if complete then 
-	   self#html_of_info 
+	   self#html_of_info ~indent: false
 	 else 
 	   self#html_of_info_first_sentence 
 	) b m.m_info
@@ -1416,17 +1614,17 @@ class html =
          else
          bs b (Name.simple mt.mt_name)
       );
-      (match mt.mt_type with
+      (match mt.mt_kind with
         None -> ()
-      | Some mtyp -> 
+      | Some k -> 
 	  bs b " = ";
-	  self#html_of_module_type b father mtyp
+	  self#html_of_module_type_kind b father ~mt k
       );
       bs b "</pre>";
       if info then
         (
 	 if complete then 
-	   self#html_of_info
+	   self#html_of_info ~indent: false
 	 else
 	   self#html_of_info_first_sentence
 	) b mt.mt_info
@@ -1456,6 +1654,99 @@ class html =
       bs b "</pre>\n";
       self#html_of_info b im.im_info
 
+    method html_of_class_element b element =
+      match element with
+        Class_attribute a ->
+          self#html_of_attribute b a
+      | Class_method m ->
+          self#html_of_method b m
+      | Class_comment t ->
+          self#html_of_class_comment b t
+
+    method html_of_class_kind b father ?cl kind =
+      match kind with
+        Class_structure (inh, eles) -> 
+	  self#html_of_text b [Code "object"];
+	  (
+	   match cl with
+	     None ->
+	       bs b "\n";
+	       (
+		match inh with
+		  [] -> ()
+		| _ -> 
+		    self#generate_inheritance_info b inh
+	       );
+	       List.iter (self#html_of_class_element b) eles;
+	   | Some cl ->
+	       let (html_file, _) = Naming.html_files cl.cl_name in
+	       bp b " <a href=\"%s\">..</a> " html_file
+	  );
+	  self#html_of_text b [Code "end"]
+
+      | Class_apply capp ->
+	  (* TODO: afficher le type final � partir du typedtree *)
+	  self#html_of_text b [Raw "class application not handled yet"]
+            
+      | Class_constr cco ->
+	  (
+           match cco.cco_type_parameters with
+             [] -> ()
+           | l -> 
+               self#html_of_class_type_param_expr_list b father l;
+	       bs b " "
+	  );
+	  self#html_of_text b
+	    [Code (self#create_fully_qualified_idents_links father cco.cco_name)]
+
+      | Class_constraint (ck, ctk) ->
+          self#html_of_text b [Code "( "] ;
+          self#html_of_class_kind b father ck;
+          self#html_of_text b [Code " : "] ;
+          self#html_of_class_type_kind b father ctk;
+          self#html_of_text b [Code " )"]
+
+    method html_of_class_type_kind b father ?ct kind =
+      match kind with
+        Class_type cta -> 
+          (
+           match cta.cta_type_parameters with
+             [] -> ()
+           | l -> 
+	       self#html_of_class_type_param_expr_list b father l;
+	       bs b " "
+          );
+          self#html_of_text b
+	    [Code (self#create_fully_qualified_idents_links father cta.cta_name)]
+
+      | Class_signature (inh, eles) -> 
+	  self#html_of_text b [Code "object"];
+	  (
+	   match ct with
+	     None ->
+	       bs b "\n";
+	       (
+		match inh with
+		  [] -> ()
+		| _ -> self#generate_inheritance_info b inh
+	       );
+	       List.iter (self#html_of_class_element b) eles
+	   | Some ct ->
+	       let (html_file, _) = Naming.html_files ct.clt_name in
+	       bp b " <a href=\"%s\">..</a> " html_file
+	  );
+	  self#html_of_text b [Code "end"]
+
+    method html_of_class_parameter b father p =
+      self#html_of_type_expr b father (Parameter.typ p)
+
+    method html_of_class_parameter_list b father params =
+      List.iter
+	(fun p -> 
+	  self#html_of_class_parameter b father p;
+	  bs b " -&gt; ")
+	params
+
     (** Print html code for a class. *)
     method html_of_class b ?(complete=true) ?(with_link=true) c =
       let father = Name.father c.cl_name in
@@ -1492,12 +1783,13 @@ class html =
       );
 
       bs b " : " ;
-      self#html_of_class_type_expr b father c.cl_type;
+      self#html_of_class_parameter_list b father c.cl_parameters ;
+      self#html_of_class_kind b father ~cl: c c.cl_kind;
       bs b "</pre>" ;
       print_DEBUG "html#html_of_class : info" ;
       (
        if complete then 
-	 self#html_of_info 
+	 self#html_of_info ~indent: false
        else 
 	 self#html_of_info_first_sentence
       ) b c.cl_info
@@ -1535,11 +1827,11 @@ class html =
         bs b (Name.simple ct.clt_name);
 
       bs b " = ";
-      self#html_of_class_type_expr b father ct.clt_type;
+      self#html_of_class_type_kind b father ~ct ct.clt_kind;
       bs b "</pre>";
       (
        if complete then 
-	 self#html_of_info 
+	 self#html_of_info ~indent: false
        else 
 	 self#html_of_info_first_sentence
       ) b ct.clt_info
@@ -1738,16 +2030,7 @@ class html =
         (* a horizontal line *)
         bs b "<hr width=\"100%\">\n";
         (* the various elements *)
-        List.iter 
-          (fun element ->
-            match element with
-              Class_attribute a ->
-                self#html_of_attribute b a
-            | Class_method m ->
-                self#html_of_method b m
-            | Class_comment t ->
-                self#html_of_class_comment b t
-          )
+        List.iter (self#html_of_class_element b)
           (Class.class_elements ~trans:false cl);
         bs b "</body></html>";
 	Buffer.output_buffer chanout b;
@@ -1792,16 +2075,7 @@ class html =
         (* a horizontal line *)
         bs b "<hr width=\"100%\">\n";
         (* the various elements *)
-        List.iter 
-          (fun element ->
-            match element with
-              Class_attribute a ->
-                self#html_of_attribute b a
-            | Class_method m ->
-                self#html_of_method b m
-            | Class_comment t ->
-                self#html_of_class_comment b t
-          )
+        List.iter (self#html_of_class_element b)
           (Class.class_type_elements ~trans: false clt);
         bs b "</body></html>";
 	Buffer.output_buffer chanout b;
@@ -1844,32 +2118,14 @@ class html =
         self#html_of_modtype b ~with_link: false mt;
            
         (* parameters for functors *)
-        self#html_of_module_parameter_list b "" (Module.module_type_parameters mt);
+        self#html_of_module_parameter_list b 
+	  (Name.father mt.mt_name)
+	  (Module.module_type_parameters mt);
         (* a horizontal line *)
         bs b "<hr width=\"100%\">\n";
         (* module elements *)
-        List.iter 
-          (fun ele ->
-            match ele with
-              Element_module m ->
-                self#html_of_module b ~complete: false m
-            | Element_module_type mt ->
-                self#html_of_modtype b ~complete: false mt
-            | Element_included_module im ->
-                self#html_of_included_module b im
-            | Element_class c ->
-                self#html_of_class b ~complete: false c
-            | Element_class_type ct ->
-                self#html_of_class_type b ~complete: false ct
-            | Element_value v ->
-                self#html_of_value b v
-            | Element_exception e ->
-                self#html_of_exception b e
-            | Element_type t ->
-                self#html_of_type b t
-            | Element_module_comment text ->
-                self#html_of_module_comment b text
-          )
+        List.iter
+	  (self#html_of_module_element b (Name.father mt.mt_name))
           (Module.module_type_elements mt);
 
         bs b "</body></html>";
@@ -1937,35 +2193,16 @@ class html =
         self#html_of_module b ~with_link: false modu;
 
         (* parameters for functors *)
-        self#html_of_module_parameter_list b "" (Module.module_parameters modu);
+        self#html_of_module_parameter_list b
+	  (Name.father modu.m_name)
+	  (Module.module_parameters modu);
 
         (* a horizontal line *)
         bs b "<hr width=\"100%\">\n";
 
         (* module elements *)
         List.iter 
-          (fun ele ->
-            print_DEBUG "html#generate_for_module : ele ->";
-            match ele with
-              Element_module m ->
-                self#html_of_module b ~complete: false m
-            | Element_module_type mt ->
-                self#html_of_modtype b ~complete: false mt
-            | Element_included_module im ->
-                self#html_of_included_module b im
-            | Element_class c ->
-                self#html_of_class b ~complete: false c
-            | Element_class_type ct ->
-                self#html_of_class_type b ~complete: false ct
-            | Element_value v ->
-                self#html_of_value b v
-            | Element_exception e ->
-                self#html_of_exception b e
-            | Element_type t ->
-                self#html_of_type b t
-            | Element_module_comment text ->
-                self#html_of_module_comment b text
-          )
+          (self#html_of_module_element b (Name.father modu.m_name))
           (Module.module_elements modu);
 
         bs b "</body></html>";
@@ -2002,14 +2239,9 @@ class html =
        @raise Failure if an error occurs.*)
     method generate_index module_list =
       try
-        let chanout = open_out (Filename.concat !Args.target_dir index) in
+        let chanout = open_out (Filename.concat !Args.target_dir self#index) in
 	let b = new_buf () in
         let title = match !Args.title with None -> "" | Some t -> self#escape t in
-        let index_if_not_empty l url m =
-          match l with
-            [] -> ()
-          | _ -> bp b "<a href=\"%s\">%s</a><br>\n" url m
-        in
 	bs b "<html>\n";
         self#print_header b self#title;
         bs b "<body>\n";
@@ -2019,28 +2251,15 @@ class html =
 	let info = Odoc_info.apply_opt
 	    Odoc_info.info_of_comment_file !Odoc_info.Args.intro_file 
 	in
-	self#html_of_info b info;
-	(match info with None -> () | Some _ -> bs b "<br/>");
-        index_if_not_empty list_types index_types Odoc_messages.index_of_types;
-        index_if_not_empty list_exceptions index_exceptions Odoc_messages.index_of_exceptions;
-        index_if_not_empty list_values index_values Odoc_messages.index_of_values;
-        index_if_not_empty list_attributes index_attributes Odoc_messages.index_of_attributes;
-        index_if_not_empty list_methods index_methods Odoc_messages.index_of_methods;
-        index_if_not_empty list_classes index_classes Odoc_messages.index_of_classes;
-        index_if_not_empty list_class_types index_class_types Odoc_messages.index_of_class_types;
-        index_if_not_empty list_modules index_modules Odoc_messages.index_of_modules;
-        index_if_not_empty list_module_types index_module_types Odoc_messages.index_of_module_types;
-        bs b "<br>\n<table class=\"indextable\">\n";
-	List.iter
-          (fun m ->
-            let (html, _) = Naming.html_files m.m_name in
-            bp b "<tr><td><a href=\"%s\">%s</a></td>" html m.m_name;
-            bs b "<td>";
-	    self#html_of_info_first_sentence b m.m_info;
-	    bs b "</td></tr>\n"
-	  )
-          module_list;
-        bs b "</table>\n</body>\n</html>";
+	(
+	 match info with
+	   None ->
+	     self#html_of_Index_list b;
+	     bs b "<br/>";
+	     self#html_of_Module_list b
+	       (List.map (fun m -> m.m_name) module_list)
+	 | Some i -> self#html_of_info ~indent: false b info
+	);
 	Buffer.output_buffer chanout b;
         close_out chanout
       with
@@ -2050,93 +2269,93 @@ class html =
     (** Generate the values index in the file [index_values.html]. *)
     method generate_values_index module_list =
       self#generate_elements_index 
-        list_values
+        self#list_values
         (fun v -> v.val_name) 
         (fun v -> v.val_info)
         Naming.complete_value_target
         Odoc_messages.index_of_values
-        index_values
+        self#index_values
 
     (** Generate the exceptions index in the file [index_exceptions.html]. *)
     method generate_exceptions_index module_list =
       self#generate_elements_index 
-        list_exceptions
+        self#list_exceptions
         (fun e -> e.ex_name) 
         (fun e -> e.ex_info)
         Naming.complete_exception_target
         Odoc_messages.index_of_exceptions
-        index_exceptions
+        self#index_exceptions
 
     (** Generate the types index in the file [index_types.html]. *)
     method generate_types_index module_list =
       self#generate_elements_index 
-        list_types
+        self#list_types
         (fun t -> t.ty_name) 
         (fun t -> t.ty_info)
         Naming.complete_type_target
         Odoc_messages.index_of_types
-        index_types
+        self#index_types
 
     (** Generate the attributes index in the file [index_attributes.html]. *)
     method generate_attributes_index module_list =
       self#generate_elements_index 
-        list_attributes
+        self#list_attributes
         (fun a -> a.att_value.val_name) 
         (fun a -> a.att_value.val_info)
         Naming.complete_attribute_target
         Odoc_messages.index_of_attributes
-        index_attributes
+        self#index_attributes
 
     (** Generate the methods index in the file [index_methods.html]. *)
     method generate_methods_index module_list =
       self#generate_elements_index 
-        list_methods
+        self#list_methods
         (fun m -> m.met_value.val_name) 
         (fun m -> m.met_value.val_info)
         Naming.complete_method_target
         Odoc_messages.index_of_methods
-        index_methods
+        self#index_methods
 
     (** Generate the classes index in the file [index_classes.html]. *)
     method generate_classes_index module_list =
       self#generate_elements_index
-        list_classes
+        self#list_classes
         (fun c -> c.cl_name) 
         (fun c -> c.cl_info)
         (fun c -> fst (Naming.html_files c.cl_name))
         Odoc_messages.index_of_classes
-        index_classes
+        self#index_classes
 
     (** Generate the class types index in the file [index_class_types.html]. *)
     method generate_class_types_index module_list =
       self#generate_elements_index
-        list_class_types
+        self#list_class_types
         (fun ct -> ct.clt_name) 
         (fun ct -> ct.clt_info)
         (fun ct -> fst (Naming.html_files ct.clt_name))
         Odoc_messages.index_of_class_types
-        index_class_types
+        self#index_class_types
 
     (** Generate the modules index in the file [index_modules.html]. *)
     method generate_modules_index module_list =
       self#generate_elements_index
-        list_modules
+        self#list_modules
         (fun m -> m.m_name) 
         (fun m -> m.m_info)
         (fun m -> fst (Naming.html_files m.m_name))
         Odoc_messages.index_of_modules
-        index_modules
+        self#index_modules
 
     (** Generate the module types index in the file [index_module_types.html]. *)
     method generate_module_types_index module_list =
       let module_types = Odoc_info.Search.module_types module_list in
       self#generate_elements_index
-        list_module_types
+        self#list_module_types
         (fun mt -> mt.mt_name) 
         (fun mt -> mt.mt_info)
         (fun mt -> fst (Naming.html_files mt.mt_name))
         Odoc_messages.index_of_module_types
-        index_module_types
+        self#index_module_types
 
     (** Generate all the html files from a module list. The main
        file is [index.html]. *)
@@ -2158,20 +2377,38 @@ class html =
       self#prepare_header module_list ;
       (* Get the names of all known types. *)
       let types = Odoc_info.Search.types module_list in
-      let type_names = List.map (fun t -> t.ty_name) types in
-      known_types_names <- type_names ;
+      known_types_names <- 
+	List.fold_left 
+	  (fun acc t -> StringSet.add t.ty_name acc) 
+	  known_types_names
+	  types ;
       (* Get the names of all class and class types. *)
       let classes = Odoc_info.Search.classes module_list in
       let class_types = Odoc_info.Search.class_types module_list in
-      let class_names = List.map (fun c -> c.cl_name) classes in
-      let class_type_names = List.map (fun ct -> ct.clt_name) class_types in
-      known_classes_names <- class_names @ class_type_names ;
+      known_classes_names <- 
+	List.fold_left
+	  (fun acc c -> StringSet.add c.cl_name acc) 
+	  known_classes_names 
+	  classes ;
+      known_classes_names <-  
+	List.fold_left
+	  (fun acc ct -> StringSet.add ct.clt_name acc) 
+	  known_classes_names
+	  class_types ;
       (* Get the names of all known modules and module types. *)
       let module_types = Odoc_info.Search.module_types module_list in
       let modules = Odoc_info.Search.modules module_list in
-      let module_type_names = List.map (fun mt -> mt.mt_name) module_types in
-      let module_names = List.map (fun m -> m.m_name) modules in
-      known_modules_names <- module_type_names @ module_names ;
+      known_modules_names <-
+	List.fold_left 
+	  (fun acc m -> StringSet.add m.m_name acc) 
+	  known_modules_names 
+	  modules ;
+      known_modules_names <-
+	List.fold_left
+	  (fun acc mt -> StringSet.add mt.mt_name acc) 
+	  known_modules_names 
+	  module_types ;
+
       (* generate html for each module *)
       if not !Args.index_only then 
         self#generate_elements self#generate_for_module module_list ;
diff --git a/ocamldoc/odoc_info.ml b/ocamldoc/odoc_info.ml
index 83bcb527b6..97dc7b2b01 100644
--- a/ocamldoc/odoc_info.ml
+++ b/ocamldoc/odoc_info.ml
@@ -46,7 +46,8 @@ and text_element = Odoc_types.text_element =
   | Ref of string * ref_kind option
   | Superscript of text
   | Subscript of text
-
+  | Module_list of string list
+  | Index_list
 
 and text = text_element list
 
@@ -117,7 +118,7 @@ let string_of_variance t (co,cn) = Odoc_str.string_of_variance t (co, cn)
 
 let string_of_type_expr t = Odoc_print.string_of_type_expr t
 
-let string_of_type_list sep type_list = Odoc_str.string_of_type_list sep type_list
+let string_of_type_list ?par sep type_list = Odoc_str.string_of_type_list ?par sep type_list
 
 let string_of_type_param_list t = Odoc_str.string_of_type_param_list t
 
diff --git a/ocamldoc/odoc_info.mli b/ocamldoc/odoc_info.mli
index 209ee4d83a..1c724dd459 100644
--- a/ocamldoc/odoc_info.mli
+++ b/ocamldoc/odoc_info.mli
@@ -49,6 +49,9 @@ and text_element = Odoc_types.text_element =
        (** A reference to an element. Complete name and kind. *)
   | Superscript of text (** Superscripts. *)
   | Subscript of text (** Subscripts. *)
+  | Module_list of string list
+       (** The table of the given modules with their abstract. *)
+  | Index_list (** The links to the various indexes (values, types, ...) *)
 
 (** A text is a list of [text_element]. The order matters. *)
 and text = text_element list
@@ -138,13 +141,6 @@ module Parameter :
     (** A parameter is just a param_info.*)
     type parameter = param_info
 
-    (** A module parameter is just a name and a module type.*)
-    type module_parameter = Odoc_parameter.module_parameter =
-        {
-          mp_name : string ;
-          mp_type : Types.module_type ;
-        } 
-    
     (** {3 Functions} *)
     (** Acces to the name as a string. For tuples, parenthesis and commas are added. *)
     val complete_name : parameter -> string
@@ -422,12 +418,19 @@ module Module :
           mutable ma_module : mmt option ; (** The real module or module type if we could associate it. *)
         } 
 
+    and module_parameter = Odoc_module.module_parameter = {
+	mp_name : string ; (** the name *)
+	mp_type : Types.module_type ; (** the type *)
+	mp_type_code : string ; (** the original code *)
+	mp_kind : module_type_kind ; (** the way the parameter was built *)
+      } 
+
     (** Different kinds of a module. *)
     and module_kind = Odoc_module.module_kind = 
       | Module_struct of module_element list (** A complete module structure. *)
       | Module_alias of module_alias (** Complete name and corresponding module if we found it *)
-      | Module_functor of (Parameter.module_parameter list) * module_kind 
-                     (** A functor, with {e all} its parameters and the rest of its definition *)
+      | Module_functor of module_parameter * module_kind 
+                     (** A functor, with its parameter and the rest of its definition *)
       | Module_apply of module_kind * module_kind
                      (** A module defined by application of a functor. *)
       | Module_with of module_type_kind * string
@@ -460,8 +463,8 @@ module Module :
     (** Different kinds of module type. *)
     and module_type_kind = Odoc_module.module_type_kind = 
       | Module_type_struct of module_element list (** A complete module signature. *)
-      | Module_type_functor of (Odoc_parameter.module_parameter list) * module_type_kind
-            (** A functor, with {e all} its parameters and the rest of its definition *)
+      | Module_type_functor of module_parameter * module_type_kind
+            (** A functor, with its parameter and the rest of its definition *)
       | Module_type_alias of module_type_alias
             (** Complete alias name and corresponding module type if we found it. *)
       | Module_type_with of module_type_kind * string
@@ -524,7 +527,7 @@ module Module :
     val module_is_functor : t_module -> bool
 
     (** The list of couples (module parameter, optional description). *)
-    val module_parameters : ?trans:bool-> t_module -> (Parameter.module_parameter * text option) list
+    val module_parameters : ?trans:bool-> t_module -> (module_parameter * text option) list
 
     (** The list of module comments. *)
     val module_comments : ?trans:bool-> t_module -> text list
@@ -571,7 +574,7 @@ module Module :
     val module_type_is_functor : t_module_type -> bool
 
     (** The list of couples (module parameter, optional description). *)
-    val module_type_parameters : ?trans:bool-> t_module_type -> (Parameter.module_parameter * text option) list
+    val module_type_parameters : ?trans:bool-> t_module_type -> (module_parameter * text option) list
 
     (** The list of module comments. *)
     val module_type_comments : ?trans:bool-> t_module_type -> text list
@@ -618,7 +621,7 @@ val string_of_type_expr : Types.type_expr -> string
 
 (** This function returns a string to represent the given list of types,
    with a given separator. *)
-val string_of_type_list : string -> Types.type_expr list -> string
+val string_of_type_list : ?par: bool -> string -> Types.type_expr list -> string
 
 (** This function returns a string to represent the list of type parameters
    for the given type. *)
@@ -626,14 +629,16 @@ val string_of_type_param_list : Type.t_type -> string
 
 (** This function returns a string to represent the given list of 
    type parameters of a class or class type,
-   with a given separator. It writes in and flushes [Format.str_formatter].*)
+   with a given separator. *)
 val string_of_class_type_param_list : Types.type_expr list -> string
 
 (** This function returns a string representing a [Types.module_type]. 
    @param complete indicates if we must print complete signatures
    or just [sig end]. Default if [false].
+   @param code if [complete = false] and the type contains something else
+   than identificators and functors, then the given code is used.
 *)
-val string_of_module_type : ?complete: bool -> Types.module_type -> string
+val string_of_module_type : ?code: string -> ?complete: bool -> Types.module_type -> string
 
 (** This function returns a string representing a [Types.class_type]. 
    @param complete indicates if we must print complete signatures
diff --git a/ocamldoc/odoc_latex.ml b/ocamldoc/odoc_latex.ml
index 7da4d23891..757b837971 100644
--- a/ocamldoc/odoc_latex.ml
+++ b/ocamldoc/odoc_latex.ml
@@ -23,6 +23,35 @@ open Exception
 open Class 
 open Module
 
+let new_buf () = Buffer.create 1024
+let new_fmt () =
+  let b = new_buf () in
+  let fmt = Format.formatter_of_buffer b in
+  (fmt,
+   fun () -> 
+    Format.pp_print_flush fmt ();
+    let s = Buffer.contents b in
+    Buffer.reset b;
+    s
+  )
+
+let p = Format.fprintf
+let ps f s = Format.fprintf f "%s" s
+
+
+let bp = Printf.bprintf
+let bs = Buffer.add_string
+
+let print_concat fmt sep f =
+  let rec iter = function
+      [] -> ()
+    | [c] -> f c
+    | c :: q ->
+	f c;
+	ps fmt sep;
+	iter q
+  in
+  iter
 
 (** Generation of LaTeX code from text structures. *)
 class text =
@@ -185,109 +214,140 @@ class text =
     (** Return latex code for the ref to a given label. *)
     method make_ref label = "\\ref{"^label^"}"
 
-    (** Return the LaTeX code corresponding to the [text] parameter.*)
-    method latex_of_text t = String.concat "" (List.map self#latex_of_text_element t)
+    (** Print the LaTeX code corresponding to the [text] parameter.*)
+    method latex_of_text fmt t = 
+      List.iter (self#latex_of_text_element fmt) t
         
-    (** Return the LaTeX code for the [text_element] in parameter. *)
-    method latex_of_text_element te =
+    (** Print the LaTeX code for the [text_element] in parameter. *)
+    method latex_of_text_element fmt te =
       match te with
-      | Odoc_info.Raw s -> self#latex_of_Raw s
-      | Odoc_info.Code s -> self#latex_of_Code s
-      | Odoc_info.CodePre s -> self#latex_of_CodePre s
-      | Odoc_info.Verbatim s -> self#latex_of_Verbatim s
-      | Odoc_info.Bold t -> self#latex_of_Bold t
-      | Odoc_info.Italic t -> self#latex_of_Italic t 
-      | Odoc_info.Emphasize t -> self#latex_of_Emphasize t
-      | Odoc_info.Center t -> self#latex_of_Center t
-      | Odoc_info.Left t -> self#latex_of_Left t
-      | Odoc_info.Right t -> self#latex_of_Right t
-      | Odoc_info.List tl -> self#latex_of_List tl
-      | Odoc_info.Enum tl -> self#latex_of_Enum tl
-      | Odoc_info.Newline -> self#latex_of_Newline
-      | Odoc_info.Block t -> self#latex_of_Block t
-      | Odoc_info.Title (n, l_opt, t) -> self#latex_of_Title n l_opt t
-      | Odoc_info.Latex s -> self#latex_of_Latex s
-      | Odoc_info.Link (s, t) -> self#latex_of_Link s t
-      | Odoc_info.Ref (name, ref_opt) -> self#latex_of_Ref name ref_opt
-      | Odoc_info.Superscript t -> self#latex_of_Superscript t
-      | Odoc_info.Subscript t -> self#latex_of_Subscript t
-            
-    method latex_of_Raw s = self#escape s
-
-    method latex_of_Code s = 
+      | Odoc_info.Raw s -> self#latex_of_Raw fmt s
+      | Odoc_info.Code s -> self#latex_of_Code fmt s
+      | Odoc_info.CodePre s -> self#latex_of_CodePre fmt s
+      | Odoc_info.Verbatim s -> self#latex_of_Verbatim fmt s
+      | Odoc_info.Bold t -> self#latex_of_Bold fmt t
+      | Odoc_info.Italic t -> self#latex_of_Italic fmt t 
+      | Odoc_info.Emphasize t -> self#latex_of_Emphasize fmt t
+      | Odoc_info.Center t -> self#latex_of_Center fmt t
+      | Odoc_info.Left t -> self#latex_of_Left fmt t
+      | Odoc_info.Right t -> self#latex_of_Right fmt t
+      | Odoc_info.List tl -> self#latex_of_List fmt tl
+      | Odoc_info.Enum tl -> self#latex_of_Enum fmt tl
+      | Odoc_info.Newline -> self#latex_of_Newline fmt
+      | Odoc_info.Block t -> self#latex_of_Block fmt t
+      | Odoc_info.Title (n, l_opt, t) -> self#latex_of_Title fmt n l_opt t
+      | Odoc_info.Latex s -> self#latex_of_Latex fmt s
+      | Odoc_info.Link (s, t) -> self#latex_of_Link fmt s t
+      | Odoc_info.Ref (name, ref_opt) -> self#latex_of_Ref fmt name ref_opt
+      | Odoc_info.Superscript t -> self#latex_of_Superscript fmt t
+      | Odoc_info.Subscript t -> self#latex_of_Subscript fmt t
+      |	Odoc_info.Module_list _ -> ()
+      |	Odoc_info.Index_list -> ()
+
+    method latex_of_Raw fmt s = 
+      ps fmt (self#escape s)
+
+    method latex_of_Code fmt s = 
       let s2 = self#escape_code s in
       let s3 = Str.global_replace (Str.regexp "\n") ("\\\\\n") s2 in
-      "{\\tt{"^s3^"}}"
-
-    method latex_of_CodePre s =
-      "\\begin{ocamldoccode}\n"^(self#escape_simple s)^"\n\\end{ocamldoccode}\n"
-
-    method latex_of_Verbatim s = "\\begin{verbatim}"^s^"\\end{verbatim}"
-
-    method latex_of_Bold t =
-      let s = self#latex_of_text t in
-      "{\\bf "^s^"}"
-
-    method latex_of_Italic t = 
-      let s = self#latex_of_text t in
-      "{\\it "^s^"}"
-
-    method latex_of_Emphasize t =
-      let s = self#latex_of_text t in
-      "{\\em "^s^"}"
-
-    method latex_of_Center t =
-      let s = self#latex_of_text t in
-      "\\begin{center}\n"^s^"\\end{center}\n"
-
-    method latex_of_Left t =
-      let s = self#latex_of_text t in
-      "\\begin{flushleft}\n"^s^"\\end{flushleft}\n"
-
-    method latex_of_Right t =
-      let s = self#latex_of_text t in
-      "\\begin{flushright}\n"^s^"\\end{flushright}\n"
-
-    method latex_of_List tl =
-      "\\begin{itemize}"^
-      (String.concat ""
-         (List.map (fun t -> "\\item "^(self#latex_of_text t)^"\n") tl))^
-      "\\end{itemize}\n"
-
-    method latex_of_Enum tl =
-      "\\begin{enumerate}"^
-      (String.concat ""
-         (List.map (fun t -> "\\item "^(self#latex_of_text t)^"\n") tl))^
-      "\\end{enumerate}\n"
-
-    method latex_of_Newline = "\n\n"
-
-    method latex_of_Block t =
-      let s = self#latex_of_text t in
-      "\\begin{ocamldocdescription}\n"^s^"\n\\end{ocamldocdescription}\n"
-
-    method latex_of_Title n label_opt t =
-      let s_title = self#latex_of_text t in
-      let s_title2 = self#section_style n s_title in
-      s_title2^
-      (match label_opt with
-        None -> ""
-      | Some l -> self#make_label (self#label ~no_: false l))
+      p fmt "{\\tt{%s}}" s3
+
+    method latex_of_CodePre fmt s =
+      ps fmt "\\begin{ocamldoccode}\n";
+      ps fmt (self#escape_simple s);
+      ps fmt "\n\\end{ocamldoccode}\n"
+
+    method latex_of_Verbatim fmt s = 
+      ps fmt "\\begin{verbatim}";
+      ps fmt s;
+      ps fmt "\\end{verbatim}"
+
+    method latex_of_Bold fmt t =
+      ps fmt "{\\bf ";
+      self#latex_of_text fmt t;
+      ps fmt "}"
+
+    method latex_of_Italic fmt t = 
+      ps fmt "{\\it ";
+      self#latex_of_text fmt t;
+      ps fmt "}"
+
+    method latex_of_Emphasize fmt t =
+      ps fmt "{\\em ";
+      self#latex_of_text fmt t;
+      ps fmt "}"
+
+    method latex_of_Center fmt t =
+      ps fmt "\\begin{center}\n";
+      self#latex_of_text fmt t;
+      ps fmt "\\end{center}\n"
+
+    method latex_of_Left fmt t =
+      ps fmt "\\begin{flushleft}\n";
+      self#latex_of_text fmt t;
+      ps fmt "\\end{flushleft}\n"
+
+    method latex_of_Right fmt t =
+      ps fmt "\\begin{flushright}\n";
+      self#latex_of_text fmt t;
+      ps fmt "\\end{flushright}\n"
+
+    method latex_of_List fmt tl =
+      ps fmt "\\begin{itemize}\n";
+      List.iter 
+	(fun t -> 
+	  ps fmt "\\item ";
+	  self#latex_of_text fmt t;
+	  ps fmt "\n"
+	) 
+	tl;
+      ps fmt "\\end{itemize}\n"
+
+    method latex_of_Enum fmt tl =
+      ps fmt "\\begin{enumerate}\n";
+      List.iter 
+	(fun t -> 
+	  ps fmt "\\item ";
+	  self#latex_of_text fmt t;
+	  ps fmt "\n"
+	) 
+	tl;
+      ps fmt "\\end{enumerate}\n"
+
+    method latex_of_Newline fmt = ps fmt "\n\n"
+
+    method latex_of_Block fmt t =
+      ps fmt "\\begin{ocamldocdescription}\n";
+      self#latex_of_text fmt t;
+      ps fmt "\n\\end{ocamldocdescription}\n"
+
+    method latex_of_Title fmt n label_opt t =
+      let (fmt2, flush) = new_fmt () in
+      self#latex_of_text fmt2 t;
+      let s_title2 = self#section_style n (flush ()) in
+      ps fmt s_title2;
+      (
+       match label_opt with
+         None -> ()
+       | Some l ->
+	   ps fmt (self#make_label (self#label ~no_: false l))
+      )
 
-    method latex_of_Latex s = s
+    method latex_of_Latex fmt s = ps fmt s
 
-    method latex_of_Link s t =
-      let s1 = self#latex_of_text t in
-      let s2 = "[\\url{"^s^"}]" in
-      s1^s2
+    method latex_of_Link fmt s t =
+      self#latex_of_text fmt t ;
+      ps fmt "[\\url{";
+      ps fmt s ;
+      ps fmt "}]"
 
-    method latex_of_Ref name ref_opt =
+    method latex_of_Ref fmt name ref_opt =
       match ref_opt with
         None -> 
-          self#latex_of_text_element 
+          self#latex_of_text_element fmt
             (Odoc_info.Code (Odoc_info.use_hidden_modules name))
       | Some (RK_section _) -> 
-          self#latex_of_text_element
+          self#latex_of_text_element fmt
             (Latex ("["^(self#make_ref (self#label ~no_:false (Name.simple name)))^"]"))
       | Some kind ->
           let f_label = 
@@ -303,16 +363,21 @@ class text =
             | Odoc_info.RK_method -> self#method_label
             | Odoc_info.RK_section _ -> assert false
           in
-          (self#latex_of_text 
-             [
-               Odoc_info.Code (Odoc_info.use_hidden_modules name) ;
-               Latex ("["^(self#make_ref (f_label name))^"]")
-             ] 
-          )
-
-    method latex_of_Superscript t = "$^{"^(self#latex_of_text t)^"}$"
-
-    method latex_of_Subscript t = "$_{"^(self#latex_of_text t)^"}$"
+          self#latex_of_text fmt
+            [
+              Odoc_info.Code (Odoc_info.use_hidden_modules name) ;
+              Latex ("["^(self#make_ref (f_label name))^"]")
+            ] 
+
+    method latex_of_Superscript fmt t = 
+      ps fmt "$^{";
+      self#latex_of_text fmt t;
+      ps fmt "}$"
+
+    method latex_of_Subscript fmt t = 
+      ps fmt "$_{";
+      self#latex_of_text fmt t;
+      ps fmt "}$"
 
   end
 
@@ -320,15 +385,15 @@ class text =
 class virtual info =
   object (self)
     (** The method used to get LaTeX code from a [text]. *)
-    method virtual latex_of_text : Odoc_info.text -> string
+    method virtual latex_of_text : Format.formatter -> Odoc_info.text -> unit
 
     (** The method used to get a [text] from an optionel info structure. *)
     method virtual text_of_info : ?block: bool -> Odoc_info.info option -> Odoc_info.text 
 
-    (** Return LaTeX code for a description, except for the [i_params] field. *)
-    method latex_of_info info_opt = 
-      self#latex_of_text 
-        (self#text_of_info ~block: false info_opt)
+    (** Print LaTeX code for a description, except for the [i_params] field. *)
+    method latex_of_info fmt ?(block=false) info_opt = 
+      self#latex_of_text fmt 
+        (self#text_of_info ~block info_opt)
   end
 
 (** This class is used to create objects which can generate a simple LaTeX documentation. *)
@@ -356,78 +421,68 @@ class latex =
                 let (_, rest) = Odoc_info.first_sentence_and_rest_of_text (self#text_of_info ~block: false i_opt) in
                 (Odoc_info.text_no_title_no_list first, rest)
 
-    (** Return LaTeX code for a value. *)
-    method latex_of_value v = 
+    (** Print LaTeX code for a value. *)
+    method latex_of_value fmt v = 
       Odoc_info.reset_type_names () ;
-      self#latex_of_text 
-        ((Latex (self#make_label (self#value_label v.val_name))) :: 
+      let label = self#value_label v.val_name in
+      let latex = self#make_label label in
+      self#latex_of_text fmt
+        ((Latex latex) :: 
          (to_text#text_of_value v))
 
-    (** Return LaTeX code for a class attribute. *)
-    method latex_of_attribute a =
-      self#latex_of_text 
+    (** Print LaTeX code for a class attribute. *)
+    method latex_of_attribute fmt a =
+      self#latex_of_text fmt
         ((Latex (self#make_label (self#attribute_label a.att_value.val_name))) :: 
          (to_text#text_of_attribute a))
 
-    (** Return LaTeX code for a class method. *)
-    method latex_of_method m = 
-      self#latex_of_text
+    (** Print LaTeX code for a class method. *)
+    method latex_of_method fmt m = 
+      self#latex_of_text fmt
         ((Latex (self#make_label (self#method_label m.met_value.val_name))) :: 
          (to_text#text_of_method m))
 
-    (** Return LaTeX code for the parameters of a type. *)
-    method latex_of_type_params m_name t =
-      let f (p, co, cn) =
-	Printf.sprintf "%s%s"
-	  (Odoc_info.string_of_variance t (co,cn))
-	  (self#normal_type m_name p)
+    (** Print LaTeX code for the parameters of a type. *)
+    method latex_of_type_params fmt m_name t =
+      let print_one (p, co, cn) =
+	ps fmt (Odoc_info.string_of_variance t (co,cn));
+	ps fmt (self#normal_type m_name p)
       in
       match t.ty_parameters with
-        [] -> ""
-      | [(p,co,cn)] -> f (p, co, cn)
+        [] -> ()
+      | [(p,co,cn)] -> print_one (p, co, cn)
       | l -> 
-	  Printf.sprintf "(%s)"
-	    (String.concat ", " (List.map f t.ty_parameters))
+	  ps fmt "(";
+	  print_concat fmt ", " print_one t.ty_parameters;
+	  ps fmt ")"
 
-    (** Return LaTeX code for a type. *)
-    method latex_of_type t =
+    (** Print LaTeX code for a type. *)
+    method latex_of_type fmt t =
       let s_name = Name.simple t.ty_name in
       let text = 
+	let (fmt2, flush2) = new_fmt () in
         Odoc_info.reset_type_names () ;
         let mod_name = Name.father t.ty_name in
-        let s_type1 = 
-          Format.fprintf Format.str_formatter "@[<hov 2>type ";
-          Format.fprintf Format.str_formatter "%s%s" 
-	    (self#latex_of_type_params mod_name t)
-	    (match t.ty_parameters with [] -> "" | _ -> " ");
-	  Format.flush_str_formatter ()
-        in
-        Format.fprintf Format.str_formatter 
-          ("@[<hov 2>%s %s")
-          s_type1
-          s_name;
-        let s_type2 = 
-	  (
-           match t.ty_manifest with
-             None -> ()
-           | Some typ -> 
-               Format.fprintf Format.str_formatter 
-		 " = %s"
-		 (self#normal_type mod_name typ)
-	  );
-	  Format.flush_str_formatter ()
-        in
+        Format.fprintf fmt2 "@[<h 2>type ";
+	self#latex_of_type_params fmt2 mod_name t;
+	(match t.ty_parameters with [] -> () | _ -> ps fmt2 " ");
+        ps fmt2 s_name;
+	(
+         match t.ty_manifest with
+           None -> ()
+         | Some typ -> 
+             p fmt2 " = %s" (self#normal_type mod_name typ)
+	);
         let s_type3 = 
-          Format.fprintf Format.str_formatter 
-            ("%s %s")
-            s_type2
+          p fmt2
+            " %s"
             (
 	     match t.ty_kind with
                Type_abstract -> ""
              | Type_variant (_, priv) -> "="^(if priv then " private" else "")
              | Type_record (_, priv) -> "= "^(if priv then "private " else "")^"{" 
 	    ) ;
-          Format.flush_str_formatter ()
+          flush2 ()
         in
         
         let defs = 
@@ -438,28 +493,28 @@ class latex =
                (List.map
                   (fun constr ->
                     let s_cons = 
-                      Format.fprintf Format.str_formatter 
-                        "@[<hov 6>  | %s"
-                        constr.vc_name;
+                      p fmt2 "@[<h 6>  | %s" constr.vc_name;
                       (
 		       match constr.vc_args with
                          [] -> ()
                        | l -> 
-                           Format.fprintf Format.str_formatter " %s@ %s" 
+                           p fmt2 " %s@ %s" 
 			     "of"
-                             (self#normal_type_list mod_name " * " l)
+                             (self#normal_type_list ~par: false mod_name " * " l)
 		      );
-		      Format.flush_str_formatter ()
+		      flush2 ()
                     in
                     [ CodePre s_cons ] @
                     (match constr.vc_text with
                       None -> []
                     | Some t -> 
-                        [ Latex
-                            ("\\begin{ocamldoccomment}\n"^
-                             (self#latex_of_text t)^
-                             "\n\\end{ocamldoccomment}\n")
-                        ] 
+			let s = 
+			  ps fmt2 "\\begin{ocamldoccomment}\n";
+			  self#latex_of_text fmt2 t;
+			  ps fmt2 "\n\\end{ocamldoccomment}\n";
+			  flush2 ()
+			in
+                        [ Latex s]
                     )
                   )
                   l
@@ -470,22 +525,24 @@ class latex =
                  (List.map
                     (fun r ->
                       let s_field = 
-                        Format.fprintf Format.str_formatter 
-                          "@[<hov 6>  %s%s :@ %s ;"
+                        p fmt2
+			  "@[<h 6>  %s%s :@ %s ;"
                           (if r.rf_mutable then "mutable " else "")
                           r.rf_name
                           (self#normal_type mod_name r.rf_type);
-			Format.flush_str_formatter ()
+			flush2 ()
                       in
                       [ CodePre s_field ] @
                       (match r.rf_text with
                         None -> []
                       | Some t -> 
-                          [ Latex
-                              ("\\begin{ocamldoccomment}\n"^
-                               (self#latex_of_text t)^
-                               "\n\\end{ocamldoccomment}\n")
-                          ] 
+                          let s = 
+			    ps fmt2 "\\begin{ocamldoccomment}\n";
+			    self#latex_of_text fmt2 t;
+			    ps fmt2 "\n\\end{ocamldoccomment}\n";
+			    flush2 ()
+			in
+                        [ Latex s]
                       )
                     )
                     l
@@ -506,193 +563,394 @@ class latex =
         [Latex ("\\index{"^(self#type_label s_name)^"@\\verb`"^(self#label ~no_:false s_name)^"`}\n")] @
         (self#text_of_info t.ty_info)
       in
-      self#latex_of_text 
+      self#latex_of_text fmt
         ((Latex (self#make_label (self#type_label t.ty_name))) :: text)
 
-    (** Return LaTeX code for an exception. *)
-    method latex_of_exception e =
+    (** Print LaTeX code for an exception. *)
+    method latex_of_exception fmt e =
       Odoc_info.reset_type_names () ;
-      self#latex_of_text 
+      self#latex_of_text fmt
         ((Latex (self#make_label (self#exception_label e.ex_name))) :: 
          (to_text#text_of_exception e))
 
-    (** Return the LaTeX code for the given module. 
-       @param for_detail indicate if we must print the type ([false]) or just ["sig"] ([true]).*)
-    method latex_of_module ?(for_detail=false) ?(with_link=true) m =
-      let buf = Buffer.create 32 in
-      let f = Format.formatter_of_buffer buf in
+    method latex_of_module_parameter fmt m_name p =
+      self#latex_of_text fmt 
+	[
+	  Code "functor (";
+	  Code p.mp_name ;
+	  Code " : ";
+	] ;
+      self#latex_of_module_type_kind fmt m_name p.mp_kind;
+      self#latex_of_text fmt [ Code ") -> "]
+
+
+    method latex_of_module_type_kind fmt father kind =
+      match kind with
+	Module_type_struct eles ->
+	  self#latex_of_text fmt [Latex "\\begin{ocamldocsigend}\n"];
+	  List.iter (self#latex_of_module_element fmt father) eles;
+	  self#latex_of_text fmt [Latex "\\end{ocamldocsigend}\n"]
+      | Module_type_functor (p, k) ->
+	  self#latex_of_module_parameter fmt father p;
+	  self#latex_of_module_type_kind fmt father k
+      | Module_type_alias a ->
+	  self#latex_of_text fmt 
+	    [Code (self#relative_module_idents father a.mta_name)]
+      | Module_type_with (k, s) ->
+	  self#latex_of_module_type_kind fmt father k;
+	  self#latex_of_text fmt 
+	    [ Code " "; 
+	      Code (self#relative_idents father s);
+	    ]
+	    
+    method latex_of_module_kind fmt father kind =
+      match kind with
+	Module_struct eles ->
+	  self#latex_of_text fmt [Latex "\\begin{ocamldocsigend}\n"];
+	  List.iter (self#latex_of_module_element fmt father) eles;
+	  self#latex_of_text fmt [Latex "\\end{ocamldocsigend}\n"]
+      | Module_alias a ->
+	  self#latex_of_text fmt 
+	    [Code (self#relative_module_idents father a.ma_name)]
+      | Module_functor (p, k) ->
+	  self#latex_of_module_parameter fmt father p;
+	  self#latex_of_module_kind fmt father k
+      | Module_apply (k1, k2) ->
+	  (* TODO: l'application n'est pas correcte dans un .mli. 
+	     Que faire ? -> afficher le module_type du typedtree  *)
+	  self#latex_of_module_kind fmt father k1;
+	  self#latex_of_text fmt [Code "("];
+	  self#latex_of_module_kind fmt father k2;
+	  self#latex_of_text fmt [Code ")"]
+      | Module_with (k, s) ->
+	  (* TODO: � modifier quand Module_with sera plus d�taill� *)
+	  self#latex_of_module_type_kind fmt father k;
+	  self#latex_of_text fmt 
+	    [ Code " "; 
+	      Code (self#relative_idents father s) ;
+	    ]
+      | Module_constraint (k, tk) ->
+	  (* TODO: on affiche quoi ? *)
+	  self#latex_of_module_kind fmt father k
+
+    method latex_of_class_parameter fmt father p =
+      ps fmt (self#normal_type father (Parameter.typ p))
+
+    method latex_of_class_parameter_list fmt father params =
+      List.iter
+	(fun p -> 
+	  self#latex_of_class_parameter fmt father p;
+	  ps fmt " -> ")
+	params
+
+    method latex_of_class_kind fmt father kind =
+      match kind with
+        Class_structure (inh, eles) -> 
+	  self#latex_of_text fmt [Latex "\\begin{ocamldocobjectend}\n"];
+	  self#generate_inheritance_info fmt inh;
+	  List.iter (self#latex_of_class_element fmt father) eles;
+	  self#latex_of_text fmt [Latex "\\end{ocamldocobjectend}\n"]
+
+      | Class_apply capp ->
+	  (* TODO: afficher le type final � partir du typedtree *)
+	  self#latex_of_text fmt [Raw "class application not handled yet"]
+            
+      | Class_constr cco ->
+	  (
+           match cco.cco_type_parameters with
+             [] -> ()
+           | l -> 
+               self#latex_of_text fmt
+		 (
+		  Code "[" ::
+		  (self#text_of_class_type_param_expr_list father l) @
+		  [Code "] "]
+		 )
+	  );
+	  self#latex_of_text fmt
+	    [Code (self#relative_idents father cco.cco_name)]
+
+      | Class_constraint (ck, ctk) ->
+          self#latex_of_text fmt [Code "( "] ;
+          self#latex_of_class_kind fmt father ck;
+          self#latex_of_text fmt [Code " : "] ;
+          self#latex_of_class_type_kind fmt father ctk;
+          self#latex_of_text fmt [Code " )"]
+
+    method latex_of_class_type_kind fmt father kind =
+      match kind with
+        Class_type cta -> 
+          (
+           match cta.cta_type_parameters with
+             [] -> ()
+           | l -> 
+               self#latex_of_text fmt 
+		 (Code "[" ::
+		  (self#text_of_class_type_param_expr_list father l) @
+		  [Code "] "]
+		 )
+          );
+          self#latex_of_text fmt
+	    [Code (self#relative_idents father cta.cta_name)]
+
+      | Class_signature (inh, eles) -> 
+	  self#latex_of_text fmt [Latex "\\begin{ocamldocobjectend}\n"];
+	  self#generate_inheritance_info fmt inh;
+	  List.iter (self#latex_of_class_element fmt father) eles;
+	  self#latex_of_text fmt [Latex "\\end{ocamldocobjectend}\n"]
+
+    method latex_for_module_index fmt m =
+      self#latex_of_text fmt 
+	[Latex ("\\index{"^(self#module_label m.m_name)^"@\\verb`"^
+		(self#label ~no_:false m.m_name)^"`}\n"
+	       )
+	]
+
+    method latex_for_module_type_index fmt mt =
+      self#latex_of_text fmt 
+	[Latex ("\\index{"^(self#module_type_label mt.mt_name)^"@\\verb`"^
+		(self#label ~no_:false mt.mt_name)^"`}\n"
+	       )
+	]
+
+    method latex_for_module_label fmt m =
+      ps fmt (self#make_label (self#module_label m.m_name))
+
+    method latex_for_module_type_label fmt mt =
+      ps fmt (self#make_label (self#module_type_label mt.mt_name))
+
+
+    method latex_for_class_index fmt c =
+      self#latex_of_text fmt 
+	[Latex ("\\index{"^(self#class_label c.cl_name)^"@\\verb`"^
+		(self#label ~no_:false c.cl_name)^"`}\n"
+	       )
+	]
+
+    method latex_for_class_type_index fmt ct =
+      self#latex_of_text fmt 
+	[Latex ("\\index{"^(self#class_type_label ct.clt_name)^"@\\verb`"^
+		(self#label ~no_:false ct.clt_name)^"`}\n"
+	       )
+	]
+
+    method latex_for_class_label fmt c =
+      ps fmt (self#make_label (self#class_label c.cl_name))
+
+    method latex_for_class_type_label fmt ct =
+      ps fmt (self#make_label (self#class_type_label ct.clt_name))
+
+    (** Print the LaTeX code for the given module. *)
+    method latex_of_module fmt m =
       let father = Name.father m.m_name in
       let t = 
-        Format.fprintf f "module %s" (Name.simple m.m_name);
-        Format.fprintf f " : %s"
-          (
-	   if for_detail 
-	   then "sig" 
-	   else (self#normal_module_type father m.m_type)
-	  );
-          
-        Format.pp_print_flush f ();
-
-        (CodePre (Buffer.contents buf)) ::
-        (
-         if with_link 
-         then [Odoc_info.Latex ("\\\n["^(self#make_ref (self#module_label m.m_name))^"]")]
-         else [] 
-        )
+        [
+	  Latex "\\begin{ocamldoccode}\n" ;
+	  Code "module ";
+	  Code (Name.simple m.m_name);
+          Code " : ";
+	]
       in
-      self#latex_of_text t
-
-    (** Return the LaTeX code for the given module type. 
-       @param for_detail indicate if we must print the type ([false]) or just ["sig"] ([true]).*)
-    method latex_of_module_type ?(for_detail=false) ?(with_link=true) mt =
-      let buf = Buffer.create 32 in
-      let f = Format.formatter_of_buffer buf in
+      self#latex_of_text fmt t;
+      self#latex_of_text fmt [ Latex "\\end{ocamldoccode}\n" ];
+      self#latex_for_module_label fmt m;
+      self#latex_for_module_index fmt m;
+      p fmt "@[<h 4>";
+      self#latex_of_module_kind fmt father m.m_kind;
+      (
+       match Module.module_is_functor m with
+	 false -> ()
+       | true ->
+	   self#latex_of_text fmt  [Newline];
+	   (
+	    match List.filter (fun (_,d) -> d <> None)
+		(module_parameters ~trans: false m)
+	    with
+	      [] -> ()
+	    | l ->
+		let t = 
+		  [ Bold [Raw "Parameters: "];
+		    List
+		      (List.map
+			 (fun (p,text_opt) ->
+			   let t = match text_opt with None -> [] | Some t -> t in
+			   ( Raw p.mp_name :: Raw ": " :: t)
+			 )
+			 l
+		      )
+		  ]
+	   in
+	   self#latex_of_text fmt t
+	   );
+      );
+      self#latex_of_text fmt [Newline];
+      self#latex_of_info fmt ~block: true m.m_info;
+      p fmt "@]";
+
+
+    (** Print the LaTeX code for the given module type. *)
+    method latex_of_module_type fmt mt =
       let father = Name.father mt.mt_name in
       let t = 
-        Format.fprintf f "module type %s" (Name.simple mt.mt_name);
-        (match mt.mt_type with
-          None -> ()
-        | Some mtyp -> 
-            Format.fprintf f " = %s"
-              (
-	       if for_detail 
-	       then "sig" 
-	       else (self#normal_module_type father mtyp)
-	      )
-        );
-
-        Format.pp_print_flush f ();
-
-        (CodePre (Buffer.contents buf)) ::
-        (
-         if with_link 
-         then [Odoc_info.Latex ("\\\n["^(self#make_ref (self#module_type_label mt.mt_name))^"]")]
-         else [] 
-        )
+        [
+	  Latex "\\begin{ocamldoccode}\n" ;
+	  Code "module type " ;
+	  Code (Name.simple mt.mt_name);
+	] 
       in
-      self#latex_of_text t
-
-    (** Return the LaTeX code for the given included module. *)
-    method latex_of_included_module im =
-      (self#latex_of_text ((Code "include ") ::
-                           (Code 
-                              (match im.im_module with
-                                None -> im.im_name
-                              | Some (Mod m) -> m.m_name
-                              | Some (Modtype mt) -> mt.mt_name)
-			   ) ::
-			   (self#text_of_info im.im_info)
-                          )
-      )
+      self#latex_of_text fmt t;
+      (
+       match mt.mt_type, mt.mt_kind with
+       | Some mtyp, Some kind -> 
+           self#latex_of_text fmt [ Code " = " ];
+	   self#latex_of_text fmt [ Latex "\\end{ocamldoccode}\n" ];
+	   self#latex_for_module_type_label fmt mt;
+	   self#latex_for_module_type_index fmt mt;
+	   p fmt "@[<h 4>";
+	   self#latex_of_module_type_kind fmt father kind
+       | _ ->
+	   self#latex_of_text fmt [ Latex "\\end{ocamldoccode}\n" ];
+	   self#latex_for_module_type_index fmt mt;
+	   p fmt "@[<h 4>";
+      );
+      (
+       match Module.module_type_is_functor mt with
+	 false -> ()
+       | true ->
+	   self#latex_of_text fmt [Newline];
+	   (
+	    match List.filter (fun (_,d) -> d <> None)
+		(module_type_parameters ~trans: false mt)
+	    with
+	      [] -> ()
+	    | l ->
+		let t = 
+		  [ Bold [Raw "Parameters: "];
+		    List
+		      (List.map
+			 (fun (p,text_opt) ->
+			   let t = match text_opt with None -> [] | Some t -> t in
+			   ( Raw p.mp_name :: Raw ": " :: t)
+			 )
+			 l
+		      )
+		  ] 
+		in
+		self#latex_of_text fmt t
+	   );
+      );
+      self#latex_of_text fmt [Newline];
+      self#latex_of_info fmt ~block: true mt.mt_info;
+      p fmt "@]";
+
+    (** Print the LaTeX code for the given included module. *)
+    method latex_of_included_module fmt im =
+      self#latex_of_text fmt
+	((Code "include ") ::
+         (Code 
+            (match im.im_module with
+              None -> im.im_name
+            | Some (Mod m) -> m.m_name
+            | Some (Modtype mt) -> mt.mt_name)
+	 ) ::
+	 (self#text_of_info im.im_info)
+        )
 
-    (** Return the LaTeX code for the given class. 
-       @param for_detail indicate if we must print the type ([false]) or just ["object"] ([true]).*)
-    method latex_of_class ?(for_detail=false) ?(with_link=true) c =
+    (** Print the LaTeX code for the given class. *)
+    method latex_of_class fmt c =
       Odoc_info.reset_type_names () ;
-      let buf = Buffer.create 32 in
-      let f = Format.formatter_of_buffer buf in
       let father = Name.father c.cl_name in
+      let type_params =
+        match c.cl_type_parameters with
+          [] -> ""
+        | l -> (self#normal_class_type_param_list father l)^" "
+      in
       let t = 
-        Format.fprintf f "class %s" 
-          (if c.cl_virtual then "virtual " else "");
-        (
-         match c.cl_type_parameters with
-           [] -> ()
-         | l -> 
-             let s1 = self#normal_class_type_param_list father l in
-             Format.fprintf f "%s " s1
-        );
-        Format.fprintf f "%s : %s" 
-	  (Name.simple c.cl_name)
-          (
-	   if for_detail then
-	     "object"
-	   else
-	     self#normal_class_type father c.cl_type
-	  );
-
-        Format.pp_print_flush f ();
-        
-        (CodePre (Buffer.contents buf)) ::
-        (
-         if with_link 
-         then [Odoc_info.Latex (" ["^(self#make_ref (self#class_label c.cl_name))^"]")]
-         else [] 
-        ) 
+	[
+	  Latex "\\begin{ocamldoccode}\n" ;
+	  Code (Printf.sprintf
+		  "class %s%s%s : "
+		  (if c.cl_virtual then "virtual " else "")
+		  type_params
+		  (Name.simple c.cl_name)
+	       )
+	] 
       in
-      self#latex_of_text t
-
-    (** Return the LaTeX code for the given class type. 
-       @param for_detail indicate if we must print the type ([false]) or just ["object"] ([true]).*)
-    method latex_of_class_type ?(for_detail=false) ?(with_link=true) ct =
+      self#latex_of_text fmt t;
+      self#latex_of_class_parameter_list fmt father c.cl_parameters;
+      self#latex_of_text fmt [ Latex "\\end{ocamldoccode}\n" ];
+      self#latex_for_class_label fmt c;
+      self#latex_for_class_index fmt c;
+      p fmt "@[<h 4>";
+      self#latex_of_class_kind fmt father c.cl_kind;
+      self#latex_of_text fmt [Newline];
+      self#latex_of_info fmt ~block: true c.cl_info;
+      p fmt "@]"
+
+    (** Print the LaTeX code for the given class type. *)
+    method latex_of_class_type fmt ct =
       Odoc_info.reset_type_names () ;
-      let buf = Buffer.create 32 in
-      let f = Format.formatter_of_buffer buf in
       let father = Name.father ct.clt_name in
+      let type_params =
+        match ct.clt_type_parameters with
+          [] -> ""
+        | l -> (self#normal_class_type_param_list father l)^" "
+      in
       let t = 
-        Format.fprintf f "class type %s" 
-          (if ct.clt_virtual then "virtual " else "");
-        (
-         match ct.clt_type_parameters with
-             [] -> ()
-         | l -> 
-             let s1 = self#normal_class_type_param_list father l in
-             Format.fprintf f "%s " s1
-        );
-        Format.fprintf f "%s = %s" 
-	  (Name.simple ct.clt_name)
-          (if for_detail then
-	    "object"
-	  else
-	    self#normal_class_type father ct.clt_type
-	  );
-
-        Format.pp_print_flush f ();
-        (CodePre (Buffer.contents buf)) ::
-        (
-         if with_link 
-         then [Odoc_info.Latex (" ["^(self#make_ref (self#class_type_label ct.clt_name))^"]")]
-         else [] 
-        ) 
+	[
+	  Latex "\\begin{ocamldoccode}\n" ;
+	  Code (Printf.sprintf
+		  "class type %s%s%s = "
+		  (if ct.clt_virtual then "virtual " else "")
+		  type_params
+		  (Name.simple ct.clt_name)
+	       )
+	] 
       in
-      self#latex_of_text t
-
-    (** Return the LaTeX code for the given class element. *)
-    method latex_of_class_element class_name class_ele =
-      (self#latex_of_text [Newline])^
-      (
-       match class_ele with
-         Class_attribute att -> self#latex_of_attribute att
-       | Class_method met -> self#latex_of_method met
-       | Class_comment t ->
-           match t with
-           | [] -> ""
-           | (Title (_,_,_)) :: _ -> self#latex_of_text t
-           | _ -> self#latex_of_text [ Title ((Name.depth class_name) + 2, None, t) ]
-      )
-
-    (** Return the LaTeX code for the given module element. *)
-    method latex_of_module_element module_name module_ele =
-      (self#latex_of_text [Newline])^
-      (
-       match module_ele with
-         Element_module m -> self#latex_of_module m
-       | Element_module_type mt -> self#latex_of_module_type mt
-       | Element_included_module im -> self#latex_of_included_module im
-       | Element_class c -> self#latex_of_class c
-       | Element_class_type ct -> self#latex_of_class_type ct
-       | Element_value v -> self#latex_of_value v
-       | Element_exception e -> self#latex_of_exception e
-       | Element_type t -> self#latex_of_type t
-       | Element_module_comment t -> self#latex_of_text t
-      )
+      self#latex_of_text fmt t;
+
+      self#latex_of_text fmt [ Latex "\\end{ocamldoccode}\n" ];
+      self#latex_for_class_type_label fmt ct;
+      self#latex_for_class_type_index fmt ct;
+      p fmt "@[<h 4>";
+      self#latex_of_class_type_kind fmt father ct.clt_kind;
+      self#latex_of_text fmt [Newline];
+      self#latex_of_info fmt ~block: true ct.clt_info;
+      p fmt "@]"
+
+    (** Print the LaTeX code for the given class element. *)
+    method latex_of_class_element fmt class_name class_ele =
+      self#latex_of_text fmt [Newline];
+      match class_ele with
+        Class_attribute att -> self#latex_of_attribute fmt att
+      | Class_method met -> self#latex_of_method fmt met
+      | Class_comment t ->
+          match t with
+          | [] -> ()
+          | (Title (_,_,_)) :: _ -> self#latex_of_text fmt t
+          | _ -> self#latex_of_text fmt [ Title ((Name.depth class_name) + 2, None, t) ]
+
+    (** Print the LaTeX code for the given module element. *)
+    method latex_of_module_element fmt module_name module_ele =
+      self#latex_of_text fmt [Newline];
+      match module_ele with
+        Element_module m -> self#latex_of_module fmt m
+      | Element_module_type mt -> self#latex_of_module_type fmt mt
+      | Element_included_module im -> self#latex_of_included_module fmt im
+      | Element_class c -> self#latex_of_class fmt c
+      | Element_class_type ct -> self#latex_of_class_type fmt ct
+      | Element_value v -> self#latex_of_value fmt v
+      | Element_exception e -> self#latex_of_exception fmt e
+      | Element_type t -> self#latex_of_type fmt t
+      | Element_module_comment t -> self#latex_of_text fmt t
 
     (** Generate the LaTeX code for the given list of inherited classes.*)
-    method generate_inheritance_info chanout inher_l =
+    method generate_inheritance_info fmt inher_l =
       let f inh =
         match inh.ic_class with
           None -> (* we can't make the reference *)
-            (Odoc_info.Code inh.ic_name) ::
+	    Newline ::
+            Code ("inherit "^inh.ic_name) ::
             (match inh.ic_text with
               None -> []
             | Some t -> Newline :: t
@@ -704,29 +962,24 @@ class latex =
               | Cltype _ -> self#class_type_label inh.ic_name
             in
             (* we can create the reference *)
-            (Odoc_info.Code inh.ic_name) ::
+	    Newline ::
+            Odoc_info.Code ("inherit "^inh.ic_name) ::
             (Odoc_info.Latex (" ["^(self#make_ref label)^"]")) :: 
             (match inh.ic_text with
               None -> []
             | Some t -> Newline :: t
             )
       in
-      let text = [
-        Odoc_info.Bold [Odoc_info.Raw Odoc_messages.inherits ];
-        Odoc_info.List (List.map f inher_l)
-      ] 
-      in
-      let s = self#latex_of_text text in
-      output_string chanout s
+      List.iter (self#latex_of_text fmt) (List.map f inher_l)
 
     (** Generate the LaTeX code for the inherited classes of the given class. *)
-    method generate_class_inheritance_info chanout cl =
+    method generate_class_inheritance_info fmt cl =
       let rec iter_kind k = 
         match k with
           Class_structure ([], _) ->
             ()
         | Class_structure (l, _) ->
-            self#generate_inheritance_info chanout l
+            self#generate_inheritance_info fmt l
         | Class_constraint (k, _) ->
             iter_kind k
         | Class_apply _
@@ -736,190 +989,68 @@ class latex =
       iter_kind cl.cl_kind
 
     (** Generate the LaTeX code for the inherited classes of the given class type. *)
-    method generate_class_type_inheritance_info chanout clt =
+    method generate_class_type_inheritance_info fmt clt =
       match clt.clt_kind with
         Class_signature ([], _) ->
           ()
       | Class_signature (l, _) ->
-          self#generate_inheritance_info chanout l
+          self#generate_inheritance_info fmt l
       | Class_type _ ->
           ()
 
-    (** Generate the LaTeX code for the given class, in the given out channel. *)
-    method generate_for_class chanout c =
-      Odoc_info.reset_type_names () ;
-      let depth = Name.depth c.cl_name in
-      let (first_t, rest_t) = self#first_and_rest_of_info c.cl_info in
-      let text = [ Title (depth, None, [ Raw (Odoc_messages.clas^" ") ; Code c.cl_name ] @
-                          (match first_t with 
-                            [] -> []
-                          | t -> (Raw " : ") :: t)) ;
-                   Latex (self#make_label (self#class_label c.cl_name)) ;
-                 ] 
-      in
-      output_string chanout (self#latex_of_text text);
-      output_string chanout ((self#latex_of_class ~for_detail: true ~with_link: false c)^"\n\n") ;
-      let s_name = Name.simple c.cl_name in
-      output_string chanout
-        (self#latex_of_text [Latex ("\\index{"^(self#class_label s_name)^"@\\verb`"^(self#label ~no_:false s_name)^"`}\n")]);
-      output_string chanout (self#latex_of_text rest_t) ;
-      (* parameters *)
-      output_string chanout 
-        (self#latex_of_text (self#text_of_parameter_list (Name.father c.cl_name) c.cl_parameters));
-       
-      output_string chanout (self#latex_of_text [ Newline ] );
-      output_string chanout ("\\ocamldocvspace{0.5cm}\n\n");
-      self#generate_class_inheritance_info chanout c;
-
-      List.iter 
-        (fun ele -> output_string chanout ((self#latex_of_class_element c.cl_name ele)^"\n\n"))
-        (Class.class_elements ~trans: false c);
-
-      output_string chanout (self#latex_of_text [ CodePre "end"])
-
-    (** Generate the LaTeX code for the given class type, in the given out channel. *)
-    method generate_for_class_type chanout ct =
-      Odoc_info.reset_type_names () ;
-      let depth = Name.depth ct.clt_name in
-      let (first_t, rest_t) = self#first_and_rest_of_info ct.clt_info in
-      let text = [ Title (depth, None, [ Raw (Odoc_messages.class_type^" ") ; Code ct.clt_name ] @
-                          (match first_t with 
-                            [] -> []
-                          | t -> (Raw " : ") :: t)) ;
-                   Latex (self#make_label (self#class_type_label ct.clt_name)) ;
-                 ] 
-      in
-
-      output_string chanout (self#latex_of_text text);
-      output_string chanout ((self#latex_of_class_type ~for_detail: true ~with_link: false ct)^"\n\n") ;
-      let s_name = Name.simple ct.clt_name in
-      output_string chanout
-        (self#latex_of_text [Latex ("\\index{"^(self#class_type_label s_name)^"@\\verb`"^(self#label ~no_:false s_name)^"`}\n")]);
-      output_string chanout ((self#latex_of_text rest_t)) ;
-      output_string chanout (self#latex_of_text [ Newline]) ;
-      output_string chanout ("\\ocamldocvspace{0.5cm}\n\n");
-      self#generate_class_type_inheritance_info chanout ct;
-
-      List.iter 
-        (fun ele -> output_string chanout ((self#latex_of_class_element ct.clt_name ele)^"\n\n"))
-        (Class.class_type_elements ~trans: false ct);
-
-      output_string chanout (self#latex_of_text [ CodePre "end"])
-
-    (** Generate the LaTeX code for the given module type, in the given out channel. *)
-    method generate_for_module_type chanout mt =
-      let depth = Name.depth mt.mt_name in
-      let (first_t, rest_t) = self#first_and_rest_of_info mt.mt_info in
-      let text = [ Title (depth,  None,
-                          [ Raw (Odoc_messages.module_type^" ") ; Code mt.mt_name ] @
-                          (match first_t with 
-                            [] -> []
-                          | t -> (Raw " : ") :: t)) ;
-                   Latex (self#make_label (self#module_type_label mt.mt_name)) ;
-                 ] 
-      in
-      output_string chanout (self#latex_of_text text);
-      if depth > 1 then
-        output_string chanout ((self#latex_of_module_type ~for_detail: true ~with_link: false mt)^"\n\n");
-      let s_name = Name.simple mt.mt_name in
-      output_string chanout
-        (self#latex_of_text [Latex ("\\index{"^(self#module_type_label s_name)^"@\\verb`"^(self#label ~no_:false s_name)^"`}\n")]);
-      output_string chanout (self#latex_of_text rest_t) ;
-      (* parameters *)
-      output_string chanout 
-        (self#latex_of_text 
-           (self#text_of_module_parameter_list
-              (Module.module_type_parameters mt)));
-
-      output_string chanout (self#latex_of_text [ Newline ] );
-      output_string chanout ("\\ocamldocvspace{0.5cm}\n\n");
-      List.iter 
-        (fun ele -> output_string chanout ((self#latex_of_module_element mt.mt_name ele)^"\n\n"))
-        (Module.module_type_elements ~trans: false mt);
-
-      if depth > 1 then 
-	output_string chanout (self#latex_of_text [ CodePre "end"]);
-
-      (* create sub parts for modules, module types, classes and class types *)
-      let rec iter ele =
-        match ele with
-          Element_module m -> self#generate_for_module chanout m
-        | Element_module_type mt -> self#generate_for_module_type chanout mt
-        | Element_class c -> self#generate_for_class chanout c
-        | Element_class_type ct -> self#generate_for_class_type chanout ct
-        | _ -> ()
-      in
-      List.iter iter (Module.module_type_elements ~trans: false mt)
-
-    (** Generate the LaTeX code for the given module, in the given out channel. *)
-    method generate_for_module chanout m =
-      let depth = Name.depth m.m_name in
+    (** Generate the LaTeX code for the given top module, in the given buffer. *)
+    method generate_for_top_module fmt m =
       let (first_t, rest_t) = self#first_and_rest_of_info m.m_info in
-      let text = [ Title (depth, None,
+      let text = [ Title (1, None,
                           [ Raw (Odoc_messages.modul^" ") ; Code m.m_name ] @
                           (match first_t with 
                             [] -> []
                           | t -> (Raw " : ") :: t)) ;
-                   Latex (self#make_label (self#module_label m.m_name)) ;
                  ] 
       in
-      output_string chanout (self#latex_of_text text);
-      if depth > 1 then
-        output_string chanout ((self#latex_of_module ~for_detail:true ~with_link: false m)^"\n\n");
-      let s_name = Name.simple m.m_name in
-      output_string chanout
-        (self#latex_of_text [Latex ("\\index{"^(self#module_label s_name)^"@\\verb`"^(self#label ~no_:false s_name)^"`}\n")]);
-      output_string chanout (self#latex_of_text rest_t) ;
-      (* parameters *)
-      output_string chanout 
-        (self#latex_of_text 
-           (self#text_of_module_parameter_list
-              (Module.module_parameters m)));
-
-      output_string chanout (self#latex_of_text [ Newline ]) ;
-      output_string chanout ("\\ocamldocvspace{0.5cm}\n\n");
+      self#latex_of_text fmt text;
+      self#latex_for_module_label fmt m;
+      self#latex_for_module_index fmt m;
+      self#latex_of_text fmt rest_t ;
+
+      self#latex_of_text fmt [ Newline ] ;
+      ps fmt "\\ocamldocvspace{0.5cm}\n\n";
       List.iter 
-        (fun ele -> output_string chanout ((self#latex_of_module_element m.m_name ele)^"\n\n"))
-        (Module.module_elements ~trans: false m);
-
-      if depth > 1 then 
-	output_string chanout (self#latex_of_text [ CodePre "end"]);
-
-      (* create sub parts for modules, module types, classes and class types *)
-      let rec iter ele =
-        match ele with
-          Element_module m -> self#generate_for_module chanout m
-        | Element_module_type mt -> self#generate_for_module_type chanout mt
-        | Element_class c -> self#generate_for_class chanout c
-        | Element_class_type ct -> self#generate_for_class_type chanout ct
-        | _ -> ()
-      in
-      List.iter iter (Module.module_elements ~trans: false m)
-
-    (** Return the header of the TeX document. *)
-    method latex_header =
-      "\\documentclass[11pt]{article} \n"^
-      "\\usepackage[latin1]{inputenc} \n"^
-      "\\usepackage[T1]{fontenc} \n"^
-      "\\usepackage{fullpage} \n"^
-      "\\usepackage{url} \n"^
-      "\\usepackage{ocamldoc}\n"^
+        (fun ele -> 
+	  self#latex_of_module_element fmt m.m_name ele;
+	  ps fmt "\n\n"
+	)
+        (Module.module_elements ~trans: false m)
+
+    (** Print the header of the TeX document. *)
+    method latex_header fmt =
+      ps fmt "\\documentclass[11pt]{article} \n";
+      ps fmt "\\usepackage[latin1]{inputenc} \n";
+      ps fmt "\\usepackage[T1]{fontenc} \n";
+      ps fmt "\\usepackage{fullpage} \n";
+      ps fmt "\\usepackage{url} \n";
+      ps fmt "\\usepackage{ocamldoc}\n";
       (
        match !Args.title with 
-         None -> ""
-       | Some s -> "\\title{"^(self#escape s)^"}\n"
-      )^
-      "\\begin{document}\n"^
-      (match !Args.title with None -> "" | Some _ -> "\\maketitle\n")^
-      (if !Args.with_toc then "\\tableofcontents\n" else "")^
+         None -> ()
+       | Some s -> 
+	   ps fmt "\\title{";
+	   ps fmt (self#escape s);
+	   ps fmt "}\n"
+      );
+      ps fmt "\\begin{document}\n";
+      (match !Args.title with 
+	None -> () | 
+	Some _ -> ps fmt "\\maketitle\n"
+      );
+      if !Args.with_toc then ps fmt "\\tableofcontents\n";
       (
        let info = Odoc_info.apply_opt
 	   Odoc_info.info_of_comment_file !Odoc_info.Args.intro_file 
        in
-       Printf.sprintf "%s%s%s"
-	 (match info with None -> "" | Some _ -> "\\vspace{0.2cm}")
-	 (self#latex_of_info info)
-	 (match info with None -> "" | Some _ -> "\n\n")
+       (match info with None -> () | Some _ -> ps fmt "\\vspace{0.2cm}");
+       self#latex_of_info fmt info;
+       (match info with None -> () | Some _ -> ps fmt "\n\n")
       )
 	
 
@@ -946,14 +1077,18 @@ class latex =
     (** Generate the LaTeX file from a module list, in the {!Odoc_info.Args.out_file} file. *)
     method generate module_list =
       self#generate_style_file ;
+      let main_file = !Args.out_file in
+      let dir = Filename.dirname main_file in
       if !Args.separate_files then
         (
          let f m =
            try
              let chanout = 
-               open_out ((Filename.concat !Args.target_dir (Name.simple m.m_name))^".tex")
+               open_out ((Filename.concat dir (Name.simple m.m_name))^".tex")
              in
-             self#generate_for_module chanout m ;
+	     let fmt = Format.formatter_of_out_channel chanout in
+             self#generate_for_top_module fmt m ;
+	     Format.pp_print_flush fmt ();
              close_out chanout
            with
              Failure s
@@ -965,16 +1100,19 @@ class latex =
         );
       
       try
-        let chanout = open_out !Args.out_file in
-        let _ = if !Args.with_header then output_string chanout self#latex_header else () in
+        let chanout = open_out main_file in
+	let fmt = Format.formatter_of_out_channel chanout in
+        if !Args.with_header then self#latex_header fmt;
         List.iter 
-          (fun m -> if !Args.separate_files then
-            output_string chanout ("\\input{"^((Name.simple m.m_name))^".tex}\n")
-          else
-            self#generate_for_module chanout m
+          (fun m -> 
+	    if !Args.separate_files then
+              ps fmt ("\\input{"^((Name.simple m.m_name))^".tex}\n")
+            else
+              self#generate_for_top_module fmt m
           ) 
           module_list ;
-        let _ = if !Args.with_trailer then output_string chanout "\\end{document}" else () in
+        if !Args.with_trailer then ps fmt "\\end{document}";
+	Format.pp_print_flush fmt ();
         close_out chanout
       with
         Failure s
diff --git a/ocamldoc/odoc_latex_style.ml b/ocamldoc/odoc_latex_style.ml
index 1e557f55f0..5c0ed9bbee 100644
--- a/ocamldoc/odoc_latex_style.ml
+++ b/ocamldoc/odoc_latex_style.ml
@@ -63,14 +63,30 @@ let content ="
   }
 
 \\newenvironment{ocamldocdescription}
-{\\list{}{\\rightmargin0pt \\topsep0pt}\\raggedright\\item\\relax}
+{\\list{}{\\rightmargin0pt \\topsep0pt}\\raggedright\\item\\noindent\\relax\\ignorespaces}
 {\\endlist\\medskip}
 
 \\newenvironment{ocamldoccomment}
-{\\list{}{\\leftmargin 2\\leftmargini \\rightmargin0pt \\topsep0pt}\\raggedright\\item\\relax}
+{\\list{}{\\leftmargin 2\\leftmargini \\rightmargin0pt \\topsep0pt}\\raggedright\\item\\noindent\\relax}
 {\\endlist}
 
+\\let \\ocamldocparagraph \\paragraph
+\\def \\paragraph #1{\\ocamldocparagraph {#1}\\noindent}
+\\let \\ocamldocsubparagraph \\subparagraph
+\\def \\subparagraph #1{\\ocamldocsubparagraph {#1}\\noindent}
+
 \\let\\ocamldocvspace\\vspace
+
+\\newenvironment{ocamldocindent}{\\list{}{}\\item\\relax}{\\endlist}
+\\newenvironment{ocamldocsigend}
+     {\\noindent\\quad\\texttt{sig}\\ocamldocindent}
+     {\\endocamldocindent\\vskip -\\lastskip
+      \\noindent\\quad\\texttt{end}\\medskip}
+\\newenvironment{ocamldocobjectend}
+     {\\noindent\\quad\\texttt{object}\\ocamldocindent}
+     {\\endocamldocindent\\vskip -\\lastskip
+      \\noindent\\quad\\texttt{end}\\medskip}
+
 \\endinput
 "
 
diff --git a/ocamldoc/odoc_man.ml b/ocamldoc/odoc_man.ml
index 66232db589..12dc054a94 100644
--- a/ocamldoc/odoc_man.ml
+++ b/ocamldoc/odoc_man.ml
@@ -269,6 +269,10 @@ class man =
           bs b "^{"; self#man_of_text2 b t
       | Odoc_info.Subscript t ->
           bs b "_{"; self#man_of_text2 b t
+      |	Odoc_info.Module_list _ ->
+	  ()
+      |	Odoc_info.Index_list -> 
+	  ()
 
     (** Print groff string to display code. *)
     method man_of_code b s = self#man_of_text b [ Code s ]
@@ -311,8 +315,8 @@ class man =
       bs b "\n"
 
     (** Print groff string to display a [Types.type_expr list].*)
-    method man_of_type_expr_list b m_name sep l =
-      let s = Odoc_str.string_of_type_list sep l in
+    method man_of_type_expr_list ?par b m_name sep l =
+      let s = Odoc_str.string_of_type_list ?par sep l in
       let s2 = Str.global_replace (Str.regexp "\n") "\n.B " s in
       bs b "\n.B ";
       bs b (self#relative_idents m_name s2);
@@ -361,7 +365,9 @@ class man =
          [] -> ()
        | _ -> 
            bs b ".B of ";
-           self#man_of_type_expr_list b (Name.father e.ex_name) " * " e.ex_args
+           self#man_of_type_expr_list 
+	     ~par: false
+	     b (Name.father e.ex_name) " * " e.ex_args
       );
       (
        match e.ex_alias with
@@ -418,11 +424,11 @@ class man =
 		   bs b " *)\n "
                | l, None -> 
                    bs b "\n.B of ";
-		   self#man_of_type_expr_list b father " * " l;
+		   self#man_of_type_expr_list ~par: false b father " * " l;
 		   bs b " "
                | l, (Some t) ->
                    bs b "\n.B of ";
-		   self#man_of_type_expr_list b father " * " l;
+		   self#man_of_type_expr_list ~par: false b father " * " l;
                    bs b ".I \"  \"\n";
                    bs b "(* ";
 		   self#man_of_text b t;
diff --git a/ocamldoc/odoc_messages.ml b/ocamldoc/odoc_messages.ml
index 0143098e94..bac8df08fa 100644
--- a/ocamldoc/odoc_messages.ml
+++ b/ocamldoc/odoc_messages.ml
@@ -15,9 +15,9 @@
 
 let ok = "Ok"
 let software = "OCamldoc"
-let version = Config.version
-let magic = version^""
-let message_version = software^" "^version
+let config_version = Config.version
+let magic = config_version^""
+let message_version = software^" "^config_version
 
 (** Messages for command line *)
 
diff --git a/ocamldoc/odoc_misc.ml b/ocamldoc/odoc_misc.ml
index fe535a6180..f0868afbab 100644
--- a/ocamldoc/odoc_misc.ml
+++ b/ocamldoc/odoc_misc.ml
@@ -33,6 +33,33 @@ let input_file_as_string nom =
   close_in chanin;
   Buffer.contents buf
 
+let split_string s chars =
+  let len = String.length s in
+  let rec iter acc pos =
+    if pos >= len then
+      match acc with
+	"" -> []
+      |	_ -> [acc]
+    else
+      if List.mem s.[pos] chars then
+	match acc with
+	  "" -> iter "" (pos + 1)
+	| _ -> acc :: (iter "" (pos + 1))
+      else
+	iter (Printf.sprintf "%s%c" acc s.[pos]) (pos + 1)
+  in
+  iter "" 0
+
+let split_with_blanks s = split_string s [' ' ; '\n' ; '\r' ; '\t' ]
+
+let list_concat sep =
+  let rec iter = function
+      [] -> []
+    | [h] -> [h]
+    | h :: q -> h :: sep :: q
+  in
+  iter
+
 let string_of_longident li = String.concat "." (Longident.flatten li)
 
 let get_fields type_expr =
@@ -88,6 +115,13 @@ let rec string_of_text t =
           "^{"^(string_of_text t)^"}"
       | Odoc_types.Subscript t ->
           "^{"^(string_of_text t)^"}"
+      |	Odoc_types.Module_list l ->
+	  string_of_text
+	    (list_concat (Odoc_types.Raw ", ")
+	       (List.map (fun s -> Odoc_types.Code s) l)
+	    )
+      |	Odoc_types.Index_list ->
+	  "" 
   in
   String.concat "" (List.map iter t)
 
@@ -221,6 +255,13 @@ let rec text_no_title_no_list t =
     | Odoc_types.Link (s, t) -> [Odoc_types.Link (s, (text_no_title_no_list t))]
     | Odoc_types.Superscript t -> [Odoc_types.Superscript (text_no_title_no_list t)]
     | Odoc_types.Subscript t -> [Odoc_types.Subscript (text_no_title_no_list t)]
+    | Odoc_types.Module_list l ->
+	list_concat (Odoc_types.Raw ", ") 
+	  (List.map
+	     (fun s -> Odoc_types.Ref (s, Some Odoc_types.RK_module))
+	     l
+	  )
+    | Odoc_types.Index_list -> []
   in
   List.flatten (List.map iter t)
 
@@ -248,6 +289,8 @@ let get_titles_in_text t =
     | Odoc_types.Link (_, t)
     | Odoc_types.Superscript t 
     | Odoc_types.Subscript t  -> iter_text t
+    | Odoc_types.Module_list _ -> ()
+    | Odoc_types.Index_list -> ()
   and iter_text te = 
     List.iter iter_ele te
   in
@@ -329,8 +372,9 @@ and first_sentence_text_ele text_ele =
   | Odoc_types.Link _ 
   | Odoc_types.Ref _ 
   | Odoc_types.Superscript _ 
-  | Odoc_types.Subscript _ -> (false, text_ele, None)
-
+  | Odoc_types.Subscript _ 
+  | Odoc_types.Module_list _ 
+  | Odoc_types.Index_list -> (false, text_ele, None)
 
 let first_sentence_of_text t = 
   let (_,t2,_) = first_sentence_text t in 
diff --git a/ocamldoc/odoc_misc.mli b/ocamldoc/odoc_misc.mli
index 4b211b3737..982def9db7 100644
--- a/ocamldoc/odoc_misc.mli
+++ b/ocamldoc/odoc_misc.mli
@@ -16,6 +16,9 @@
 (** This function returns a file in the form of one string.*)
 val input_file_as_string : string -> string
 
+(** [split_with_blanks s] splits the given string [s] according to blanks. *)
+val split_with_blanks : string -> string list
+
 (** This function creates a string from a Longident.t .*)
 val string_of_longident : Longident.t -> string
 
diff --git a/ocamldoc/odoc_module.ml b/ocamldoc/odoc_module.ml
index 4714672ca8..a12545b236 100644
--- a/ocamldoc/odoc_module.ml
+++ b/ocamldoc/odoc_module.ml
@@ -45,11 +45,18 @@ and module_alias = {
     mutable ma_module : mmt option ; (** the real module or module type if we could associate it *)
   } 
 
+and module_parameter = {
+    mp_name : string ; (** the name *)
+    mp_type : Types.module_type ; (** the type *)
+    mp_type_code : string ; (** the original code *)
+    mp_kind : module_type_kind ; (** the way the parameter was built *)
+  } 
+
 (** Different kinds of module. *)
 and module_kind =
   | Module_struct of module_element list 
   | Module_alias of module_alias (** complete name and corresponding module if we found it *)
-  | Module_functor of (Odoc_parameter.module_parameter list) * module_kind
+  | Module_functor of module_parameter * module_kind
   | Module_apply of module_kind * module_kind
   | Module_with of module_type_kind * string
   | Module_constraint of module_kind * module_type_kind
@@ -76,7 +83,7 @@ and module_type_alias = {
 (** Different kinds of module type. *)
 and module_type_kind =
   | Module_type_struct of module_element list 
-  | Module_type_functor of (Odoc_parameter.module_parameter list) * module_type_kind
+  | Module_type_functor of module_parameter * module_type_kind
   | Module_type_alias of module_type_alias (** complete name and corresponding module type if we found it *)
   | Module_type_with of module_type_kind * string (** the module type kind and the code of the with constraint *)
 
@@ -313,25 +320,21 @@ let module_comments ?(trans=true) m = comments (module_elements ~trans m)
 let rec module_type_parameters ?(trans=true) mt =
   let rec iter k =
     match k with
-      Some (Module_type_functor (params, _)) -> 
-        (
-         (* we create the couple (parameter, description opt), using
-            the description of the parameter if we can find it in the comment.*)
-         match mt.mt_info with
-           None ->
-             List.map (fun p -> (p, None)) params
-         | Some i ->
-             List.map 
-               (fun p ->
-                 try
-                   let d = List.assoc p.Odoc_parameter.mp_name i.Odoc_types.i_params in
-                   (p, Some d)
-                 with
-                   Not_found ->
-                     (p, None)
-               )
-               params
-        )
+      Some (Module_type_functor (p, k2)) -> 
+        let param =
+           (* we create the couple (parameter, description opt), using
+              the description of the parameter if we can find it in the comment.*)
+          match mt.mt_info with
+            None -> (p, None)
+          | Some i ->
+              try
+                let d = List.assoc p.mp_name i.Odoc_types.i_params in
+                (p, Some d)
+              with
+                Not_found ->
+                  (p, None)
+	in
+        param :: (iter (Some k2))
     | Some (Module_type_alias mta) ->
         if trans then
           match mta.mta_module with
@@ -352,45 +355,44 @@ let rec module_type_parameters ?(trans=true) mt =
   iter mt.mt_kind
 
 (** Access to the parameters, for a functor.
-  @param trans indicates if, for aliased modules, we must perform a transitive search.*)
+   @param trans indicates if, for aliased modules, we must perform a transitive search.*)
 and module_parameters ?(trans=true) m =
-  match m.m_kind with
-    Module_functor (params, _) -> 
-      (
-       (* we create the couple (parameter, description opt), using
-          the description of the parameter if we can find it in the comment.*)
-       match m.m_info with
-         None ->
-           List.map (fun p -> (p, None)) params
-       | Some i ->
-           List.map 
-             (fun p ->
-              try
-                let d = List.assoc p.Odoc_parameter.mp_name i.Odoc_types.i_params in
-                (p, Some d)
+  let rec iter = function
+      Module_functor (p, k) -> 
+	let param = 
+         (* we create the couple (parameter, description opt), using
+            the description of the parameter if we can find it in the comment.*)
+	  match m.m_info with
+            None ->(p, None)
+	  | Some i ->
+	      try
+		let d = List.assoc p.mp_name i.Odoc_types.i_params in
+		(p, Some d)
               with
-                Not_found ->
+		Not_found ->
                   (p, None)
-             )
-             params
-      )
-  | Module_alias ma ->
-      if trans then
-        match ma.ma_module with
-          None -> []
-        | Some (Mod m) -> module_parameters ~trans m
-        | Some (Modtype mt) -> module_type_parameters ~trans mt
-      else
-        []
-  | Module_constraint (k, tk) ->
-      module_type_parameters ~trans: trans
-        { mt_name = "" ; mt_info = None ; mt_type = None ;
-          mt_is_interface = false ; mt_file = "" ; mt_kind = Some tk ;
-          mt_loc = Odoc_types.dummy_loc }
-  | Module_struct _ 
-  | Module_apply _ 
-  | Module_with _ ->
-      []
+	in
+	param :: (iter k)
+
+    | Module_alias ma ->
+	if trans then
+          match ma.ma_module with
+            None -> []
+          | Some (Mod m) -> module_parameters ~trans m
+          | Some (Modtype mt) -> module_type_parameters ~trans mt
+	else
+          []
+    | Module_constraint (k, tk) ->
+	module_type_parameters ~trans: trans
+          { mt_name = "" ; mt_info = None ; mt_type = None ;
+            mt_is_interface = false ; mt_file = "" ; mt_kind = Some tk ;
+            mt_loc = Odoc_types.dummy_loc }
+    | Module_struct _ 
+    | Module_apply _ 
+    | Module_with _ ->
+	[]
+  in
+  iter m.m_kind
 
 (** access to all submodules and sudmobules of submodules ... of the given module.
   @param trans indicates if, for aliased modules, we must perform a transitive search.*)
@@ -420,18 +422,21 @@ let rec module_type_is_functor mt =
   iter mt.mt_kind
 
 (** The module is a functor if is defined as a functor or if it is an alias for a functor. *)
-let rec module_is_functor m = 
-  match m.m_kind with
-    Module_functor _ -> true
-  | Module_alias ma ->
-      (
-       match ma.ma_module with
-         None -> false 
-       | Some (Mod mo) -> module_is_functor mo
-       | Some (Modtype mt) -> module_type_is_functor mt
-      )
-  | _ -> false
-
+let module_is_functor m = 
+  let rec iter = function
+      Module_functor _ -> true
+    | Module_alias ma ->
+	(
+	 match ma.ma_module with
+           None -> false 
+	 | Some (Mod mo) -> iter mo.m_kind
+	 | Some (Modtype mt) -> module_type_is_functor mt
+	)
+    | Module_constraint (k, _) ->
+	iter k
+    | _ -> false
+  in
+  iter m.m_kind
 
 (** Returns the list of values of a module type. 
   @param trans indicates if, for aliased modules, we must perform a transitive search.*)
diff --git a/ocamldoc/odoc_name.ml b/ocamldoc/odoc_name.ml
index ef01ec4a3f..e518d57cf6 100644
--- a/ocamldoc/odoc_name.ml
+++ b/ocamldoc/odoc_name.ml
@@ -60,7 +60,7 @@ let cut name =
                      '(' -> 
                        j := 1
                    | _ ->
-                       Buffer.add_char buf.(!j) '('
+                       Buffer.add_char buf.(!j) '.'
                  else
                    Buffer.add_char buf.(!j) s.[i]
              | c ->
@@ -79,10 +79,28 @@ let father name = fst (cut name)
 
 let concat n1 n2 = n1^"."^n2
 
-let head n =
-  match Str.split (Str.regexp "\\.") n with
-    [] -> n
-  | h :: _ -> h
+let head_and_tail n =
+  try
+    let pos = String.index n '.' in
+    if pos > 0 then
+      let h = String.sub n 0 pos in
+      try
+	ignore (String.index h '(');
+	(n, "")
+      with
+	Not_found ->
+	  let len = String.length n in
+	  if pos >= (len - 1) then
+	    (h, "")
+	  else
+	    (h, String.sub n (pos + 1) (len - pos - 1))
+    else
+      (n, "")
+  with
+    Not_found -> (n, "")
+
+let head n = fst (head_and_tail n)
+let tail n = snd (head_and_tail n)
 
 let depth name =
   try
@@ -98,6 +116,20 @@ let prefix n1 n2 =
     (n2.[len1] = '.')
   with _ -> false)
 
+let rec get_relative_raw n1 n2 =
+  let (f1,s1) = head_and_tail n1 in
+  let (f2,s2) = head_and_tail n2 in
+  if f1 = f2 then
+    if f2 = s2 or s2 = "" then
+      s2
+    else
+      if f1 = s1 or s1 = "" then
+	s2
+      else
+	get_relative_raw s1 s2
+  else
+    n2
+
 let get_relative n1 n2 =
   if prefix n1 n2 then
     let len1 = String.length n1 in
@@ -142,21 +174,3 @@ let to_path n =
 
 let from_longident longident = String.concat "." (Longident.flatten longident)
 
-let name_alias name cpl_aliases =
-  let rec f n1 = function
-      [] -> raise Not_found
-    | (n2, n3) :: q ->
-        if n2 = n1 then 
-          n3
-        else
-          if prefix n2 n1 then
-            let ln2 = String.length n2 in
-            n3^(String.sub n1 ln2 ((String.length n1) - ln2))
-          else
-            f n1 q
-  in
-  let rec iter n =
-    try iter (f n cpl_aliases)
-    with Not_found -> n
-  in
-  iter name
diff --git a/ocamldoc/odoc_name.mli b/ocamldoc/odoc_name.mli
index b0a5d55440..33b661f937 100644
--- a/ocamldoc/odoc_name.mli
+++ b/ocamldoc/odoc_name.mli
@@ -41,9 +41,12 @@ val prefix : t -> t -> bool
 (** Take two names n1 and n2 = n3.n4 and return n4 if n3=n1 or else n2. *)
 val get_relative : t -> t -> t
 
+(** Take two names n1=n3.n4 and n2 = n5.n6 and return n6 if n3=n5 or else n2. *)
+val get_relative_raw : t -> t -> t
+
 (** Take a list of module names to hide and a name,
    and return the name when the module name (or part of it)
-   was removedn, according to the list of module names to hide.*)
+   was removed, according to the list of module names to hide.*)
 val hide_given_modules : t list -> t -> t
 
 (** Indicate if a name if qualified or not. *)
@@ -61,6 +64,3 @@ val to_path : t -> Path.t
 (** Get a name from a [Longident.t].*)
 val from_longident : Longident.t -> t
 
-(** This function takes a name and a list of name aliases and returns the name
-   after substitution using the aliases. *)
-val name_alias : t -> (t * t) list -> t
diff --git a/ocamldoc/odoc_parameter.ml b/ocamldoc/odoc_parameter.ml
index 790250fc82..ba7ff1de30 100644
--- a/ocamldoc/odoc_parameter.ml
+++ b/ocamldoc/odoc_parameter.ml
@@ -11,8 +11,7 @@
 
 (* $Id$ *)
 
-(** Representation and manipulation of method / function / class parameters,
-   and module parameters.*)
+(** Representation and manipulation of method / function / class parameters. *)
 
 let print_DEBUG s = print_string s ; print_newline ()
 
@@ -34,13 +33,6 @@ type param_info =
 (** A parameter is just a param_info.*)
 type parameter = param_info
 
-(** A module parameter is just a name and a module type.*)
-type module_parameter = {
-    mp_name : string ;
-    mp_type : Types.module_type ;
-  } 
-
-
 (** Functions *)
 
 (** acces to the name as a string. For tuples, parenthesis and commas are added. *)
diff --git a/ocamldoc/odoc_print.ml b/ocamldoc/odoc_print.ml
index 409e0523ce..1aa9a5dcec 100644
--- a/ocamldoc/odoc_print.ml
+++ b/ocamldoc/odoc_print.ml
@@ -44,22 +44,36 @@ let string_of_type_expr t =
   Printtyp.type_scheme_max ~b_reset_names: false type_fmt t;
   flush_type_fmt ()
 
+exception Use_code of string
+
 (** Return the given module type where methods and vals have been removed
-   from the signatures. Used when we don't want to print a too long module type.*)
-let simpl_module_type t =
+   from the signatures. Used when we don't want to print a too long module type.
+   @param code when the code is given, we raise the [Use_code] exception is we
+   encouter a signature, to that the calling function can use the code rather
+   than the "emptied" type.
+*)
+let simpl_module_type ?code t =
   let rec iter t =
     match t with
       Types.Tmty_ident p -> t
-    | Types.Tmty_signature _ -> Types.Tmty_signature []
+    | Types.Tmty_signature _ -> 
+	(
+	 match code with
+	   None -> Types.Tmty_signature []
+	 | Some s -> raise (Use_code s)
+	)
     | Types.Tmty_functor (id, mt1, mt2) ->
         Types.Tmty_functor (id, iter mt1, iter mt2)
   in
   iter t
 
-let string_of_module_type ?(complete=false) t =
-  let t2 = if complete then t else simpl_module_type t in
-  Printtyp.modtype modtype_fmt t2;
-  flush_modtype_fmt ()
+let string_of_module_type ?code ?(complete=false) t =
+  try
+    let t2 = if complete then t else simpl_module_type ?code t in
+    Printtyp.modtype modtype_fmt t2;
+    flush_modtype_fmt ()
+  with
+    Use_code s -> s
 
 (** Return the given class type where methods and vals have been removed
    from the signatures. Used when we don't want to print a too long class type.*)
@@ -75,6 +89,7 @@ let simpl_class_type t =
                                                   Types.desc = Types.Tobject (tnil, ref None) };
                                Types.cty_vars = Types.Vars.empty ;
                                Types.cty_concr = Types.Concr.empty ;
+                               Types.cty_inher = []
                              }
     | Types.Tcty_fun (l, texp, ct) ->
         let new_ct = iter ct in
diff --git a/ocamldoc/odoc_print.mli b/ocamldoc/odoc_print.mli
index 0e7cc2f9d8..b0b11997d1 100644
--- a/ocamldoc/odoc_print.mli
+++ b/ocamldoc/odoc_print.mli
@@ -20,8 +20,10 @@ val string_of_type_expr : Types.type_expr -> string
 (** This function returns a string representing a [Types.module_type]. 
    @param complete indicates if we must print complete signatures
    or just [sig end]. Default if [false].
+   @param code if [complete = false] and the type contains something else
+   than identificators and functors, then the given code is used.
 *)
-val string_of_module_type : ?complete: bool -> Types.module_type -> string
+val string_of_module_type : ?code: string -> ?complete: bool -> Types.module_type -> string
 
 (** This function returns a string representing a [Types.class_type]. 
    @param complete indicates if we must print complete signatures
diff --git a/ocamldoc/odoc_search.ml b/ocamldoc/odoc_search.ml
index 990930d695..d25aee63d5 100644
--- a/ocamldoc/odoc_search.ml
+++ b/ocamldoc/odoc_search.ml
@@ -79,7 +79,9 @@ module Search =
       | T.Link (_, t) -> search_text root t v
       | T.List l 
       | T.Enum l -> List.flatten (List.map (fun t -> search_text root t v) l)
-      | T.Newline -> []
+      | T.Newline 
+      |	T.Module_list _
+      |	T.Index_list -> []
       | T.Title (n, l_opt, t) -> 
           (match l_opt with
             None -> []
diff --git a/ocamldoc/odoc_sig.ml b/ocamldoc/odoc_sig.ml
index cb025f22d1..20ee0ed693 100644
--- a/ocamldoc/odoc_sig.ml
+++ b/ocamldoc/odoc_sig.ml
@@ -51,13 +51,13 @@ module Signature_search =
           Hashtbl.add table (V (Name.from_ident ident)) signat
       | Types.Tsig_exception (ident, _) ->
           Hashtbl.add table (E (Name.from_ident ident)) signat
-      | Types.Tsig_type (ident, _) ->
+      | Types.Tsig_type (ident, _, _) ->
           Hashtbl.add table (T (Name.from_ident ident)) signat
-      | Types.Tsig_class (ident,_) ->
+      | Types.Tsig_class (ident, _, _) ->
           Hashtbl.add table (C (Name.from_ident ident)) signat
-      | Types.Tsig_cltype (ident, _) ->
+      | Types.Tsig_cltype (ident, _, _) ->
           Hashtbl.add table (CT (Name.from_ident ident)) signat
-      | Types.Tsig_module (ident, _) ->
+      | Types.Tsig_module (ident, _, _) ->
           Hashtbl.add table (M (Name.from_ident ident)) signat
       | Types.Tsig_modtype (ident,_) ->
           Hashtbl.add table (MT (Name.from_ident ident)) signat
@@ -80,22 +80,22 @@ module Signature_search =
 
     let search_type table name =
       match Hashtbl.find table (T name) with
-      | (Types.Tsig_type (_, type_decl)) -> type_decl
+      | (Types.Tsig_type (_, type_decl, _)) -> type_decl
       | _ -> assert false
 
     let search_class table name =
       match Hashtbl.find table (C name) with
-      | (Types.Tsig_class (_, class_decl)) -> class_decl
+      | (Types.Tsig_class (_, class_decl, _)) -> class_decl
       | _ -> assert false
 
     let search_class_type table name =
       match Hashtbl.find table (CT name) with
-      | (Types.Tsig_cltype (_, cltype_decl)) -> cltype_decl
+      | (Types.Tsig_cltype (_, cltype_decl, _)) -> cltype_decl
       | _ -> assert false
 
     let search_module table name =
       match Hashtbl.find table (M name) with
-      | (Types.Tsig_module (ident, module_type)) -> module_type
+      | (Types.Tsig_module (ident, module_type, _)) -> module_type
       | _ -> assert false
 
     let search_module_type table name =
@@ -285,7 +285,7 @@ module Analyser =
       let f_DEBUG var (mutable_flag, type_exp) = print_DEBUG var in
       Types.Vars.iter f_DEBUG class_signature.Types.cty_vars;
       print_DEBUG ("Type de la classe "^current_class_name^" : ");
-      print_DEBUG (Odoc_misc.string_of_type_expr class_signature.Types.cty_self);
+      print_DEBUG (Odoc_print.string_of_type_expr class_signature.Types.cty_self);
       let get_pos_limit2 q =
         match q with
           [] -> pos_limit
@@ -1077,23 +1077,31 @@ module Analyser =
                raise (Failure "Parsetree.Pmty_signature signature but not Types.Tmty_signature signat")
           )
             
-      | Parsetree.Pmty_functor (_,_, module_type2) ->
+      | Parsetree.Pmty_functor (_,pmodule_type2, module_type2) ->
           (
+	   let loc_start = pmodule_type2.Parsetree.pmty_loc.Location.loc_start.Lexing.pos_cnum in
+           let loc_end = pmodule_type2.Parsetree.pmty_loc.Location.loc_end.Lexing.pos_cnum in
+	   let mp_type_code = get_string_of_file loc_start loc_end in
+	   print_DEBUG (Printf.sprintf "mp_type_code=%s" mp_type_code);
            match sig_module_type with
              Types.Tmty_functor (ident, param_module_type, body_module_type) ->
+	       let mp_kind = analyse_module_type_kind env 
+		   current_module_name pmodule_type2 param_module_type 
+	       in
                let param = 
                  {
                    mp_name = Name.from_ident ident ;
                    mp_type = Odoc_env.subst_module_type env param_module_type ;
+		   mp_type_code = mp_type_code ;
+		   mp_kind = mp_kind ;
                  } 
                in
-               (
-                match analyse_module_type_kind env current_module_name module_type2 body_module_type with
-                  Module_type_functor (params, k) ->
-                    Module_type_functor (param :: params, k)
-                | k ->
-                    Module_type_functor ([param], k)
-               )
+	       let k = analyse_module_type_kind env 
+		   current_module_name 
+		   module_type2 
+		   body_module_type 
+	       in
+               Module_type_functor (param, k)
 
            | _ ->
                (* if we're here something's wrong *)
@@ -1140,23 +1148,31 @@ module Analyser =
                (* if we're here something's wrong *)
                raise (Failure "Parsetree.Pmty_signature signature but not Types.Tmty_signature signat")
           )
-      | Parsetree.Pmty_functor (_,_,module_type2) (* of string * module_type * module_type *) ->
+      | Parsetree.Pmty_functor (_,pmodule_type2,module_type2) (* of string * module_type * module_type *) ->
           (
            match sig_module_type with
              Types.Tmty_functor (ident, param_module_type, body_module_type) ->
+	       let loc_start = pmodule_type2.Parsetree.pmty_loc.Location.loc_start.Lexing.pos_cnum in
+               let loc_end = pmodule_type2.Parsetree.pmty_loc.Location.loc_end.Lexing.pos_cnum in
+	       let mp_type_code = get_string_of_file loc_start loc_end in
+	       print_DEBUG (Printf.sprintf "mp_type_code=%s" mp_type_code);
+	       let mp_kind = analyse_module_type_kind env 
+		   current_module_name pmodule_type2 param_module_type 
+	       in
                let param = 
                  {
                    mp_name = Name.from_ident ident ;
                    mp_type = Odoc_env.subst_module_type env param_module_type ;
+		   mp_type_code = mp_type_code ;
+		   mp_kind = mp_kind ;
                  } 
                in
-               (
-                match analyse_module_kind env current_module_name module_type2 body_module_type with
-                  Module_functor (params, k) ->
-                    Module_functor (param :: params, k)
-                | k ->
-                    Module_functor ([param], k)
-               )
+               let k = analyse_module_kind env 
+		   current_module_name 
+		   module_type2 
+		   body_module_type 
+	       in
+               Module_functor (param, k)
                      
            | _ ->
                (* if we're here something's wrong *)
@@ -1196,7 +1212,7 @@ module Analyser =
           let f_DEBUG var (mutable_flag, type_exp) = print_DEBUG var in
           Types.Vars.iter f_DEBUG class_signature.Types.cty_vars;
           print_DEBUG ("Type de la classe "^current_class_name^" : ");
-          print_DEBUG (Odoc_misc.string_of_type_expr class_signature.Types.cty_self);
+          print_DEBUG (Odoc_print.string_of_type_expr class_signature.Types.cty_self);
           (* we get the elements of the class in class_type_field_list *)
           let (inher_l, ele) = analyse_class_elements env current_class_name 
               last_pos
@@ -1250,7 +1266,7 @@ module Analyser =
           let f_DEBUG var (mutable_flag, type_exp) = print_DEBUG var in
           Types.Vars.iter f_DEBUG class_signature.Types.cty_vars;
           print_DEBUG ("Type de la classe "^current_class_name^" : ");
-          print_DEBUG (Odoc_misc.string_of_type_expr class_signature.Types.cty_self);
+          print_DEBUG (Odoc_print.string_of_type_expr class_signature.Types.cty_self);
           (* we get the elements of the class in class_type_field_list *)
           let (inher_l, ele) = analyse_class_elements env current_class_name
               last_pos
@@ -1321,41 +1337,18 @@ module Analyser =
 	else
 	  None
       in
-      let m =
-        {
-          m_name = mod_name ;
-          m_type = Types.Tmty_signature signat ;
-          m_info = info_opt ;
-          m_is_interface = true ;
-          m_file = !file_name ;
-          m_kind = Module_struct elements ;
-          m_loc = { loc_impl = None ; loc_inter = Some (!file_name, 0) } ;
-          m_top_deps = [] ;
-	  m_code = None ;
-	  m_code_intf = code_intf ;
-        } 
-      in
-      
-      print_DEBUG "El�ments du module:";
-      let f e =
-        let s = 
-          match e with
-            Element_module m -> "module "^m.m_name
-          | Element_module_type mt -> "module type "^mt.mt_name
-          | Element_included_module im -> "included module "^im.im_name
-          | Element_class c -> "class "^c.cl_name
-          | Element_class_type ct -> "class type "^ct.clt_name
-          | Element_value v -> "value "^v.val_name
-          | Element_exception e -> "exception "^e.ex_name
-          | Element_type t -> "type "^t.ty_name
-          | Element_module_comment t -> Odoc_misc.string_of_text t
-        in
-        print_DEBUG s;
-        ()
-      in
-      List.iter f elements;
-
-      m
+      {
+        m_name = mod_name ;
+        m_type = Types.Tmty_signature signat ;
+        m_info = info_opt ;
+        m_is_interface = true ;
+        m_file = !file_name ;
+        m_kind = Module_struct elements ;
+        m_loc = { loc_impl = None ; loc_inter = Some (!file_name, 0) } ;
+        m_top_deps = [] ;
+	m_code = None ;
+	m_code_intf = code_intf ;
+      } 
           
     end
 
diff --git a/ocamldoc/odoc_str.ml b/ocamldoc/odoc_str.ml
index c644675f6c..de82a9e46a 100644
--- a/ocamldoc/odoc_str.ml
+++ b/ocamldoc/odoc_str.ml
@@ -69,11 +69,14 @@ let raw_string_of_type_list sep type_list =
   Format.pp_print_flush fmt ();
   Buffer.contents buf
 
-let string_of_type_list sep type_list =
+let string_of_type_list ?par sep type_list =
   let par =
-    match type_list with
-      [] | [_] -> false
-    | _ -> true
+    match par with
+    | Some b -> b
+    | None ->
+	match type_list with
+	  [] | [_] -> false
+	| _ -> true
   in
   Printf.sprintf "%s%s%s"
     (if par then "(" else "")
diff --git a/ocamldoc/odoc_str.mli b/ocamldoc/odoc_str.mli
index a06852ebe3..6c9fa820c8 100644
--- a/ocamldoc/odoc_str.mli
+++ b/ocamldoc/odoc_str.mli
@@ -17,16 +17,18 @@
 val string_of_variance : Odoc_type.t_type -> (bool * bool) -> string
 
 (** This function returns a string to represent the given list of types,
-   with a given separator. It writes in and flushes [Format.str_formatter].*)
-val string_of_type_list : string -> Types.type_expr list -> string
+   with a given separator.
+   @param par can be used to force the addition or not of parentheses around the returned string.
+*)
+val string_of_type_list : ?par: bool -> string -> Types.type_expr list -> string
 
 (** This function returns a string to represent the list of type parameters
-   for the given type. It writes in and flushes [Format.str_formatter].*)
+   for the given type. *)
 val string_of_type_param_list : Odoc_type.t_type -> string
 
 (** This function returns a string to represent the given list of 
    type parameters of a class or class type,
-   with a given separator. It writes in and flushes [Format.str_formatter].*)
+   with a given separator. *)
 val string_of_class_type_param_list : Types.type_expr list -> string
 
 (** @return a string to describe the given type. *)
diff --git a/ocamldoc/odoc_texi.ml b/ocamldoc/odoc_texi.ml
index 8090a2b3c4..5eb18ca602 100644
--- a/ocamldoc/odoc_texi.ml
+++ b/ocamldoc/odoc_texi.ml
@@ -1,7 +1,7 @@
 (***********************************************************************)
 (*                           OCamldoc                                  *)
 (*                                                                     *)
-(*      Olivier Andrieu, bas� sur du code de Maxence Guesdon           *)
+(*      Olivier Andrieu, base sur du code de Maxence Guesdon           *)
 (*                                                                     *)
 (*  Copyright 2001 Institut National de Recherche en Informatique et   *)
 (*  en Automatique.  All rights reserved.  This file is distributed    *)
@@ -297,6 +297,8 @@ class text =
       | Ref (name, kind) ->self#texi_of_Ref name kind
       | Superscript t -> self#texi_of_Superscript t
       | Subscript t -> self#texi_of_Subscript t
+      |	Odoc_info.Module_list _ -> ""
+      |	Odoc_info.Index_list -> ""
 
     method texi_of_Verbatim s = s
     method texi_of_Raw s = self#escape s
diff --git a/ocamldoc/odoc_text.ml b/ocamldoc/odoc_text.ml
index b83c88a19f..85578098b7 100644
--- a/ocamldoc/odoc_text.ml
+++ b/ocamldoc/odoc_text.ml
@@ -134,6 +134,12 @@ module Texter =
 	  )
       | Superscript t -> p b "{^" ; p_text b t ; p b "}"
       | Subscript t -> p b "{_" ; p_text b t ; p b "}"
+      | Module_list l -> 
+	  p b "{!modules:";
+	  List.iter (fun s -> p b " %s" s) l;
+	  p b "}"
+      |	Index_list ->
+	  p b "{!indexlist}"
 	    
     let string_of_text s =
       let b = Buffer.create 256 in
diff --git a/ocamldoc/odoc_text_lexer.mll b/ocamldoc/odoc_text_lexer.mll
index f21ec9ae39..f0c3738a6f 100644
--- a/ocamldoc/odoc_text_lexer.mll
+++ b/ocamldoc/odoc_text_lexer.mll
@@ -160,8 +160,8 @@ let begin_clt_ref = "{!classtype:"blank_nl | "{!classtype:"
 let begin_att_ref = "{!attribute:"blank_nl | "{!attribute:"
 let begin_met_ref = "{!method:"blank_nl | "{!method:"
 let begin_sec_ref = "{!section:"blank_nl | "{!section:"
-
-
+let begin_mod_list_ref = "{!modules:"blank_nl | "{!modules:"
+let index_list = "{!indexlist}"
 let begin_superscript = "{^"blank_nl | "{^"
 let begin_subscript = "{_"blank_nl | "{_"
 
@@ -641,6 +641,34 @@ rule main = parse
           )
     }
 
+| begin_mod_list_ref
+    {
+      incr_cpts lexbuf ;
+      if !verb_mode or !latex_mode or !code_pre_mode or !open_brackets >= 1 then
+        Char (Lexing.lexeme lexbuf)
+      else
+        if not !ele_ref_mode then
+          (
+           ele_ref_mode := true;
+           MOD_LIST_REF
+          )
+        else
+          (
+           Char (Lexing.lexeme lexbuf)
+          )
+    }
+
+| index_list
+    {
+      incr_cpts lexbuf ;
+      if !verb_mode or !latex_mode or !code_pre_mode or !open_brackets >= 1 then
+        Char (Lexing.lexeme lexbuf)
+      else
+	if not !ele_ref_mode then
+          INDEX_LIST
+	else
+	  Char (Lexing.lexeme lexbuf)
+    } 
 
 | begin_verb    
     {
@@ -708,7 +736,10 @@ rule main = parse
          END_SHORTCUT_LIST
         )
       else
-        BLANK_LINE
+	if !latex_mode or (!open_brackets >= 1) or !code_pre_mode or !ele_ref_mode or !verb_mode then
+	  Char (Lexing.lexeme lexbuf)
+	else
+          BLANK_LINE
     } 
    
 | eof           { EOF }
diff --git a/ocamldoc/odoc_text_parser.mly b/ocamldoc/odoc_text_parser.mly
index 2abd562f74..8711ca05fb 100644
--- a/ocamldoc/odoc_text_parser.mly
+++ b/ocamldoc/odoc_text_parser.mly
@@ -60,7 +60,8 @@ let print_DEBUG s = print_string s; print_newline ()
 %token ATT_REF
 %token MET_REF
 %token SEC_REF
-
+%token MOD_LIST_REF
+%token INDEX_LIST
 
 %token SUPERSCRIPT
 %token SUBSCRIPT
@@ -164,6 +165,13 @@ text_element:
       let s3 = remove_trailing_blanks s2 in
       Ref (s3, Some (RK_section []))
      }
+| MOD_LIST_REF string END { 
+      let s2 = remove_beginning_blanks $2 in
+      let s3 = remove_trailing_blanks s2 in
+      let l = Odoc_misc.split_with_blanks s3 in
+      Module_list l
+     }
+| INDEX_LIST { Index_list } 
 | VERB string END_VERB { Verbatim $2 }
 | LATEX string END_LATEX { Latex $2 }
 | LINK string END text END { Link ($2, $4) }
diff --git a/ocamldoc/odoc_to_text.ml b/ocamldoc/odoc_to_text.ml
index a80eb3889a..426432a65f 100644
--- a/ocamldoc/odoc_to_text.ml
+++ b/ocamldoc/odoc_to_text.ml
@@ -188,21 +188,37 @@ class virtual to_text =
       in
       s2
 
+    (** Take a string and return the string where fully qualified idents 
+       have been replaced by idents relative to the given module name.
+       Also remove the "hidden modules".*)
+    method relative_module_idents m_name s =
+      let f str_t = 
+        let match_s = Str.matched_string str_t in
+        let rel = Name.get_relative m_name match_s in
+        Odoc_info.apply_if_equal Odoc_info.use_hidden_modules match_s rel
+      in
+      let s2 = Str.global_substitute
+          (Str.regexp "\\([A-Z]\\([a-zA-Z_'0-9]\\)*\\.\\)+\\([A-Z][a-zA-Z_'0-9]*\\)")
+          f
+          s
+      in
+      s2
+
     (** Get a string for a [Types.class_type] where all idents are relative. *)
     method normal_class_type m_name t =
       (self#relative_idents m_name (Odoc_info.string_of_class_type t))
 
     (** Get a string for a [Types.module_type] where all idents are relative. *)
-    method normal_module_type m_name t =
-      (self#relative_idents m_name (Odoc_info.string_of_module_type t))
+    method normal_module_type ?code m_name t =
+      (self#relative_module_idents m_name (Odoc_info.string_of_module_type ?code t))
 
     (** Get a string for a type where all idents are relative. *)
     method normal_type m_name t =
       (self#relative_idents m_name (Odoc_info.string_of_type_expr t))
 
     (** Get a string for a list of types where all idents are relative. *)
-    method normal_type_list m_name sep t =
-      (self#relative_idents m_name (Odoc_info.string_of_type_list sep t))
+    method normal_type_list ?par m_name sep t =
+      (self#relative_idents m_name (Odoc_info.string_of_type_list ?par sep t))
 
     (** Get a string for a list of class or class type type parameters
        where all idents are relative. *)
@@ -244,7 +260,8 @@ class virtual to_text =
     
     (** @return [text] value for a value. *)
     method text_of_value v =
-      let s_name = Name.simple v.val_name in
+      let name = v.val_name in
+      let s_name = Name.simple name in
       let s = 
 	Format.fprintf Format.str_formatter "@[<hov 2>val %s :@ %s"
           s_name
@@ -252,7 +269,7 @@ class virtual to_text =
 	Format.flush_str_formatter ()
       in
       [ CodePre s ] @ 
-      [Latex ("\\index{"^(self#label s_name)^"@\\verb`"^(self#label ~no_:false s_name)^"`}\n")] @
+      [Latex ("\\index{"^(self#label name)^"@\\verb`"^(self#label ~no_:false name)^"`}\n")] @
       (self#text_of_info v.val_info)
 
     (** @return [text] value for a class attribute. *)
@@ -296,7 +313,9 @@ class virtual to_text =
         | _ -> 
             Format.fprintf Format.str_formatter "@ of "
         );
-      let s = self#normal_type_list (Name.father e.ex_name) " * " e.ex_args in
+      let s = self#normal_type_list 
+	  ~par: false (Name.father e.ex_name) " * " e.ex_args 
+      in
       let s2 = 
         Format.fprintf Format.str_formatter "%s" s ;
         (match e.ex_alias with
@@ -500,25 +519,24 @@ class virtual to_text =
           [Code ((if with_def_syntax then " : " else "")^
                  Odoc_messages.struct_end^" ")]
 
-      | Module_functor (_, k)  ->
+      | Module_functor (p, k)  ->
           (if with_def_syntax then [Code " : "] else []) @
           [Code "functor ... "] @
           [Code " -> "] @
           (self#text_of_module_kind ~with_def_syntax: false k)
 
-    (** Return html code for a [module_type_kind]. *)
+    (** Return html code for a [module_type_kind].*)
     method text_of_module_type_kind ?(with_def_syntax=true) tk =
       match tk with
       | Module_type_struct _ ->
           [Code ((if with_def_syntax then " = " else "")^Odoc_messages.sig_end)]
 
-      | Module_type_functor (params, k) ->
-          let f p = 
-            [Code ("("^p.mp_name^" : ")] @ 
-            (self#text_of_module_type p.mp_type) @
+      | Module_type_functor (p, k) ->
+          let t1 =
+	    [Code ("("^p.mp_name^" : ")] @ 
+            (self#text_of_module_type_kind p.mp_kind) @
             [Code ") -> "]
           in
-          let t1 = List.flatten (List.map f params) in
           let t2 = self#text_of_module_type_kind ~with_def_syntax: false k in
           (if with_def_syntax then [Code " = "] else []) @ t1 @ t2
           
@@ -534,4 +552,5 @@ class virtual to_text =
                  | Some mt -> mt.mt_name))
           ] 
 
+
   end
diff --git a/ocamldoc/odoc_types.ml b/ocamldoc/odoc_types.ml
index fd8938ed69..1bd749c0cd 100644
--- a/ocamldoc/odoc_types.ml
+++ b/ocamldoc/odoc_types.ml
@@ -44,6 +44,8 @@ and text_element =
   | Ref of string * ref_kind option
   | Superscript of text
   | Subscript of text
+  | Module_list of string list
+  | Index_list
 
 and text = text_element list
 
diff --git a/ocamldoc/odoc_types.mli b/ocamldoc/odoc_types.mli
index 61e8db7b26..17eee74900 100644
--- a/ocamldoc/odoc_types.mli
+++ b/ocamldoc/odoc_types.mli
@@ -49,6 +49,9 @@ and text_element =
        (** A reference to an element. Complete name and kind. *)
   | Superscript of text (** Superscripts. *)
   | Subscript of text (** Subscripts. *)
+  | Module_list of string list 
+       (** The table of the given modules with their abstract; *)
+  | Index_list (** The links to the various indexes (values, types, ...) *)
 
 (** [text] is a list of text_elements. The order matters. *)
 and text = text_element list
diff --git a/ocamldoc/remove_DEBUG b/ocamldoc/remove_DEBUG
index 6dd7ad0b0f..7233afbac0 100755
--- a/ocamldoc/remove_DEBUG
+++ b/ocamldoc/remove_DEBUG
@@ -1,5 +1,18 @@
 #!/bin/sh
 
+#(***********************************************************************)
+#(*                            OCamldoc                                 *)
+#(*                                                                     *)
+#(*            Damien Doligez, projet Moscova, INRIA Rocquencourt       *)
+#(*                                                                     *)
+#(*  Copyright 2003 Institut National de Recherche en Informatique et   *)
+#(*  en Automatique.  All rights reserved.  This file is distributed    *)
+#(*  under the terms of the Q Public License version 1.0.               *)
+#(*                                                                     *)
+#(***********************************************************************)
+
+# $Id$
+
 # usage: remove_DEBUG <file>
 # remove from <file> every line that contains the string "DEBUG",
 # respecting the cpp # line annotation conventions
diff --git a/parsing/parser.mly b/parsing/parser.mly
index 66ccfaeba6..6d828d337d 100644
--- a/parsing/parser.mly
+++ b/parsing/parser.mly
@@ -936,7 +936,7 @@ simple_expr:
   | LBRACE record_expr RBRACE
       { let (exten, fields) = $2 in mkexp(Pexp_record(fields, exten)) }
   | LBRACE record_expr error
-      { unclosed "{" 1 "}" 5 }
+      { unclosed "{" 1 "}" 3 }
   | LBRACKETBAR expr_semi_list opt_semi BARRBRACKET
       { mkexp(Pexp_array(List.rev $2)) }
   | LBRACKETBAR expr_semi_list opt_semi error
diff --git a/stdlib/Makefile b/stdlib/Makefile
index 38a4c85e76..570849ff0a 100644
--- a/stdlib/Makefile
+++ b/stdlib/Makefile
@@ -18,14 +18,17 @@ include ../config/Makefile
 RUNTIME=../boot/ocamlrun
 COMPILER=../ocamlc
 CAMLC=$(RUNTIME) $(COMPILER)
-COMPFLAGS=-warn-error A -nostdlib
+COMPFLAGS=-g -warn-error A -nostdlib
 OPTCOMPILER=../ocamlopt
 CAMLOPT=$(RUNTIME) $(OPTCOMPILER)
 OPTCOMPFLAGS=-warn-error A -nostdlib
 CAMLDEP=../boot/ocamlrun ../tools/ocamldep
 
-BASIC=builtintypes.cmo \
-  pervasives.cmo array.cmo list.cmo char.cmo string.cmo sys.cmo \
+NOBUILTINFLAG=-nobuiltintypes
+
+OBJS=builtintypes.cmo \
+  pervasives.cmo $(OTHERS)
+OTHERS=array.cmo list.cmo char.cmo string.cmo sys.cmo \
   hashtbl.cmo sort.cmo marshal.cmo obj.cmo \
   int32.cmo int64.cmo nativeint.cmo \
   lexing.cmo parsing.cmo \
@@ -35,11 +38,17 @@ BASIC=builtintypes.cmo \
   digest.cmo random.cmo callback.cmo camlinternalOO.cmo oo.cmo \
   genlex.cmo weak.cmo \
   lazy.cmo filename.cmo complex.cmo \
-  rtype.cmo
-LABELLED=arrayLabels.ml listLabels.ml stringLabels.ml moreLabels.ml
-
-OBJS=$(BASIC) labelled.cmo stdLabels.cmo
-ALLOBJS=$(BASIC) $(LABELLED:.ml=.cmo) stdLabels.cmo
+  rtype.cmo \
+  arrayLabels.cmo listLabels.cmo stringLabels.cmo moreLabels.cmo stdLabels.cmo
+
+# make MODE=migration when you want to port gcaml to the latest ocaml-cvs
+ifeq ($(MODE),migration)
+ifeq ($(CAMLC),../boot/ocamlrun ../boot/ocamlc)
+# migration + coldstart
+NOBUILTINFLAG:=
+OBJS:=pervasives.cmo $(OTHERS)
+endif
+endif
 
 all: stdlib.cma std_exit.cmo camlheader camlheader_ur
 
@@ -48,6 +57,7 @@ allopt: stdlib.cmxa std_exit.cmx allopt-$(PROFILING)
 allopt-noprof:
 
 allopt-prof: stdlib.p.cmxa std_exit.p.cmx
+	rm -f std_exit.p.cmi
 
 install:
 	cp stdlib.cma std_exit.cmo *.cmi *.mli *.ml camlheader camlheader_ur \
@@ -71,13 +81,13 @@ installopt-prof:
 	cd $(LIBDIR); $(RANLIB) stdlib.p.a
 
 stdlib.cma: $(OBJS)
-	$(CAMLC) -a -o stdlib.cma $(ALLOBJS)
+	$(CAMLC) -a -o stdlib.cma $(OBJS)
 
 stdlib.cmxa: $(OBJS:.cmo=.cmx)
-	$(CAMLOPT) -a -o stdlib.cmxa $(ALLOBJS:.cmo=.cmx)
+	$(CAMLOPT) -a -o stdlib.cmxa $(OBJS:.cmo=.cmx)
 
 stdlib.p.cmxa: $(OBJS:.cmo=.p.cmx)
-	$(CAMLOPT) -a -o stdlib.p.cmxa $(ALLOBJS:.cmo=.p.cmx)
+	$(CAMLOPT) -a -o stdlib.p.cmxa $(OBJS:.cmo=.p.cmx)
 
 camlheader camlheader_ur: header.c ../config/Makefile
 	if $(SHARPBANGSCRIPTS); then \
@@ -118,20 +128,20 @@ pervasives.p.cmx: pervasives.ml
            then mv pervasives.n.o pervasives.o; else :; fi
 
 builtintypes.cmi: builtintypes.mli
-	$(CAMLC) $(COMPFLAGS) -nobuiltintypes -c builtintypes.mli
+	$(CAMLC) $(COMPFLAGS) $(NOBUILTINFLAG) -c builtintypes.mli
 
 builtintypes.cmo: builtintypes.ml
-	$(CAMLC) $(COMPFLAGS) -nobuiltintypes -c builtintypes.ml
+	$(CAMLC) $(COMPFLAGS) $(NOBUILTINFLAG) -c builtintypes.ml
 
 builtintypes.cmx: builtintypes.ml
-	$(CAMLOPT) $(OPTCOMPFLAGS) -nobuiltintypes -c builtintypes.ml
+	$(CAMLOPT) $(OPTCOMPFLAGS) $(NOBUILTINFLAG) -c builtintypes.ml
 
 builtintypes.p.cmx: builtintypes.ml
 	@if test -f builtintypes.cmx; \
            then mv builtintypes.cmx builtintypes.n.cmx; else :; fi
 	@if test -f builtintypes.o; \
            then mv builtintypes.o builtintypes.n.o; else :; fi
-	$(CAMLOPT) $(OPTCOMPFLAGS) -p -nobuiltintypes -c builtintypes.ml
+	$(CAMLOPT) $(OPTCOMPFLAGS) -p $(NOBUILTINFLAG) -c builtintypes.ml
 	mv builtintypes.cmx builtintypes.p.cmx
 	mv builtintypes.o builtintypes.p.o
 	@if test -f builtintypes.n.cmx; \
@@ -184,28 +194,30 @@ labelled.p.cmx:
 .SUFFIXES: .mli .ml .cmi .cmo .cmx .p.cmx
 
 .mli.cmi:
-	$(CAMLC) $(COMPFLAGS) $(EXTRAFLAGS) -c $<
+	$(CAMLC) $(COMPFLAGS) `./Compflags $@` -c $<
 
 .ml.cmo:
-	$(CAMLC) $(COMPFLAGS) $(EXTRAFLAGS) -c $<
+	$(CAMLC) $(COMPFLAGS) `./Compflags $@` -c $<
 
 .ml.cmx:
-	$(CAMLOPT) $(OPTCOMPFLAGS) $(EXTRAFLAGS) -c $<
+	$(CAMLOPT) $(OPTCOMPFLAGS) `./Compflags $@` -c $<
 
 .ml.p.cmx:
-	@if test -f $*.cmx; then mv $*.cmx $*.n.cmx; else :; fi
-	@if test -f $*.o; then mv $*.o $*.n.o; else :; fi
-	$(CAMLOPT) $(OPTCOMPFLAGS) $(EXTRAFLAGS) -p -c $<
-	mv $*.cmx $*.p.cmx
-	mv $*.o $*.p.o
-	@if test -f $*.n.cmx; then mv $*.n.cmx $*.cmx; else :; fi
-	@if test -f $*.n.o; then mv $*.n.o $*.o; else :; fi
-
-$(ALLOBJS) labelled.cmo std_exit.cmo: pervasives.cmi $(COMPILER)
-$(ALLOBJS:.cmo=.cmx) labelled.cmx std_exit.cmx: pervasives.cmi $(OPTCOMPILER)
-$(ALLOBJS:.cmo=.p.cmx) labelled.p.cmx std_exit.p.cmx: pervasives.cmi $(OPTCOMPILER)
-$(ALLOBJS:.cmo=.cmi) std_exit.cmi: $(COMPILER)
-labelled.cmo labelled.cmx labelled.p.cmx: $(LABELLED) $(LABELLED:.ml=.mli)
+	$(CAMLOPT) $(OPTCOMPFLAGS) `./Compflags $@` -p -c -o $*.p.cmx $<
+
+# Dependencies on the compiler
+$(OBJS) std_exit.cmo: $(COMPILER)
+$(OBJS:.cmo=.cmi) std_exit.cmi: $(COMPILER)
+$(OBJS:.cmo=.cmx) std_exit.cmx: $(OPTCOMPILER)
+$(OBJS:.cmo=.p.cmx) std_exit.p.cmx: $(OPTCOMPILER)
+
+# Dependencies on Pervasives (not tracked by ocamldep)
+$(OBJS) std_exit.cmo: pervasives.cmi
+$(OTHERS:.cmo=.cmi) std_exit.cmi: pervasives.cmi
+$(OBJS:.cmo=.cmx) std_exit.cmx: pervasives.cmi
+$(OBJS:.cmo=.p.cmx) std_exit.p.cmx: pervasives.cmi
+$(OTHERS:.cmo=.cmx) std_exit.cmx: pervasives.cmx
+$(OTHERS:.cmo=.p.cmx) std_exit.p.cmx: pervasives.cmx
 
 clean::
 	rm -f *.cm* *.o *.a
diff --git a/stdlib/Makefile.nt b/stdlib/Makefile.nt
index 140ae4b2dc..5df7c7ea4e 100644
--- a/stdlib/Makefile.nt
+++ b/stdlib/Makefile.nt
@@ -18,24 +18,24 @@ include ../config/Makefile
 RUNTIME=../boot/ocamlrun
 COMPILER=../ocamlc
 CAMLC=$(RUNTIME) $(COMPILER)
+COMPFLAGS=-warn-error A -nostdlib
 OPTCOMPILER=../ocamlopt
 CAMLOPT=$(RUNTIME) $(OPTCOMPILER)
+OPTCOMPFLAGS=-warn-error A -nostdlib
 CAMLDEP=../boot/ocamlrun ../tools/ocamldep
 
-BASIC=pervasives.cmo array.cmo list.cmo char.cmo string.cmo sys.cmo \
+OBJS=pervasives.cmo $(OTHERS)
+OTHERS=array.cmo list.cmo char.cmo string.cmo sys.cmo \
   hashtbl.cmo sort.cmo marshal.cmo obj.cmo \
   int32.cmo int64.cmo nativeint.cmo \
   lexing.cmo parsing.cmo \
   set.cmo map.cmo stack.cmo queue.cmo stream.cmo buffer.cmo \
   printf.cmo format.cmo scanf.cmo \
   arg.cmo printexc.cmo gc.cmo \
-  digest.cmo random.cmo camlinternalOO.cmo oo.cmo \
-  genlex.cmo callback.cmo weak.cmo \
-  lazy.cmo filename.cmo complex.cmo
-LABELLED=arrayLabels.ml listLabels.ml stringLabels.ml moreLabels.ml
-
-OBJS=$(BASIC) labelled.cmo stdLabels.cmo
-ALLOBJS=$(BASIC) $(LABELLED:.ml=.cmo) stdLabels.cmo
+  digest.cmo random.cmo callback.cmo camlinternalOO.cmo oo.cmo \
+  genlex.cmo weak.cmo \
+  lazy.cmo filename.cmo complex.cmo \
+  arrayLabels.cmo listLabels.cmo stringLabels.cmo moreLabels.cmo stdLabels.cmo
 
 all: stdlib.cma std_exit.cmo camlheader camlheader_ur
 
@@ -48,10 +48,10 @@ installopt:
 	cp stdlib.cmxa stdlib.$(A) std_exit.$(O) *.cmx $(LIBDIR)
 
 stdlib.cma: $(OBJS)
-	$(CAMLC) -a -o stdlib.cma $(ALLOBJS)
+	$(CAMLC) -a -o stdlib.cma $(OBJS)
 
 stdlib.cmxa: $(OBJS:.cmo=.cmx)
-	$(CAMLOPT) -a -o stdlib.cmxa $(ALLOBJS:.cmo=.cmx)
+	$(CAMLOPT) -a -o stdlib.cmxa $(OBJS:.cmo=.cmx)
 
 camlheader camlheader_ur: headernt.c ../config/Makefile
 	$(BYTECC) $(BYTECCCOMPOPTS) $(BYTECCLINKOPTS) -o camlheader.exe headernt.c
@@ -61,46 +61,30 @@ camlheader camlheader_ur: headernt.c ../config/Makefile
 clean::
 	rm -f camlheader camlheader_ur
 
-pervasives.cmi: pervasives.mli
-	$(CAMLC) $(COMPFLAGS) -nopervasives -c pervasives.mli
-
-pervasives.cmo: pervasives.ml
-	$(CAMLC) $(COMPFLAGS) -nopervasives -c pervasives.ml
-
-pervasives.cmx: pervasives.ml
-	$(CAMLOPT) $(COMPFLAGS) -nopervasives -c pervasives.ml
-
-# camlinternalOO.cmi must be compiled with -nopervasives for applets
-camlinternalOO.cmi: camlinternalOO.mli
-	$(CAMLC) $(COMPFLAGS) -nopervasives -c camlinternalOO.mli
-
-# labelled modules require the -nolabels flag
-labelled.cmo:
-	$(MAKEREC) EXTRAFLAGS=-nolabels RUNTIME=$(RUNTIME) COMPILER=$(COMPILER) $(LABELLED:.ml=.cmo)
-	touch $@
-labelled.cmx:
-	$(MAKEREC) EXTRAFLAGS=-nolabels $(LABELLED:.ml=.cmx)
-	touch $@
-labelled.p.cmx:
-	$(MAKEREC) EXTRAFLAGS=-nolabels $(LABELLED:.ml=.p.cmx)
-	touch $@
-
-# generic rules
 .SUFFIXES: .mli .ml .cmi .cmo .cmx
 
 .mli.cmi:
-	$(CAMLC) $(COMPFLAGS) $(EXTRAFLAGS) -c $<
+	$(CAMLC) $(COMPFLAGS) `./Compflags $@` -c $<
 
 .ml.cmo:
-	$(CAMLC) $(COMPFLAGS) $(EXTRAFLAGS) -c $<
+	$(CAMLC) $(COMPFLAGS) `./Compflags $@` -c $<
 
 .ml.cmx:
-	$(CAMLOPT) $(COMPFLAGS) $(EXTRAFLAGS) -c $<
-
-$(ALLOBJS) labelled.cmo std_exit.cmo: pervasives.cmi $(COMPILER)
-$(ALLOBJS:.cmo=.cmx) labelled.cmx std_exit.cmx: pervasives.cmi $(OPTCOMPILER)
-$(ALLOBJS:.cmo=.cmi) std_exit.cmi: $(COMPILER)
-labelled.cmo labelled.cmx: $(LABELLED) $(LABELLED:.ml=.mli)
+	$(CAMLOPT) $(OPTCOMPFLAGS) `./Compflags $@` -c $<
+
+# Dependencies on the compiler
+$(OBJS) std_exit.cmo: $(COMPILER)
+$(OBJS:.cmo=.cmi) std_exit.cmi: $(COMPILER)
+$(OBJS:.cmo=.cmx) std_exit.cmx: $(OPTCOMPILER)
+$(OBJS:.cmo=.p.cmx) std_exit.p.cmx: $(OPTCOMPILER)
+
+# Dependencies on Pervasives (not tracked by ocamldep)
+$(OBJS) std_exit.cmo: pervasives.cmi
+$(OTHERS:.cmo=.cmi) std_exit.cmi: pervasives.cmi
+$(OBJS:.cmo=.cmx) std_exit.cmx: pervasives.cmi
+$(OBJS:.cmo=.p.cmx) std_exit.p.cmx: pervasives.cmi
+$(OTHERS:.cmo=.cmx) std_exit.cmx: pervasives.cmx
+$(OTHERS:.cmo=.p.cmx) std_exit.p.cmx: pervasives.cmx
 
 clean::
 	rm -f *.cm* *.$(O) *.$(A)
diff --git a/stdlib/arg.ml b/stdlib/arg.ml
index 5ed20e1c49..9514b95576 100644
--- a/stdlib/arg.ml
+++ b/stdlib/arg.ml
@@ -70,13 +70,24 @@ let print_spec buf (key, spec, doc) =
   | _ -> bprintf buf "  %s %s\n" key doc
 ;;
 
+let help_action () = raise (Stop (Unknown "-help"));;
+
+let add_help speclist =
+  let add1 =
+    try ignore (assoc3 "-help" speclist); []
+    with Not_found ->
+            ["-help", Unit help_action, " Display this list of options"]
+  and add2 =
+    try ignore (assoc3 "--help" speclist); []
+    with Not_found ->
+            ["--help", Unit help_action, " Display this list of options"]
+  in
+  speclist @ (add1 @ add2)
+;;
+
 let usage_b buf speclist errmsg =
   bprintf buf "%s\n" errmsg;
-  List.iter (print_spec buf) speclist;
-  try ignore (assoc3 "-help" speclist)
-  with Not_found -> bprintf buf "  -help   Display this list of options\n";
-  try ignore (assoc3 "--help" speclist)
-  with Not_found -> bprintf buf "  --help  Display this list of options\n";
+  List.iter (print_spec buf) (add_help speclist);
 ;;
 
 let usage speclist errmsg =
@@ -202,3 +213,35 @@ let parse l f msg =
   | Bad msg -> eprintf "%s" msg; exit 2;
   | Help msg -> printf "%s" msg; exit 0;
 ;;
+
+let rec second_word s =
+  let len = String.length s in
+  let rec loop n =
+    if n >= len then len
+    else if s.[n] = ' ' then loop (n+1)
+    else n
+  in
+  try loop (String.index s ' ')
+  with Not_found -> len
+;;
+
+let max_arg_len cur (kwd, _, doc) =
+  max cur (String.length kwd + second_word doc)
+;;
+
+let add_padding len ksd =
+  match ksd with
+  | (_, Symbol _, _) -> ksd
+  | (kwd, spec, msg) ->
+      let cutcol = second_word msg in
+      let spaces = String.make (len - String.length kwd - cutcol) ' ' in
+      let prefix = String.sub msg 0 cutcol in
+      let suffix = String.sub msg cutcol (String.length msg - cutcol) in
+      (kwd, spec, prefix ^ spaces ^ suffix)
+;;
+
+let align speclist =
+  let completed = add_help speclist in
+  let len = List.fold_left max_arg_len 0 completed in
+  List.map (add_padding len) completed
+;;
diff --git a/stdlib/arg.mli b/stdlib/arg.mli
index a7258ada68..8203e83133 100644
--- a/stdlib/arg.mli
+++ b/stdlib/arg.mli
@@ -58,7 +58,6 @@ type spec =
                                    call the function with the symbol *)
   | Rest of (string -> unit)   (** Stop interpreting keywords and call the 
                                    function with each remaining argument *)
-
 (** The concrete type describing the behavior associated
    with a keyword. *)
 
@@ -121,6 +120,13 @@ val usage : (key * spec * doc) list -> usage_msg -> unit
     {!Arg.parse} prints in case of error.
     [speclist] and [usage_msg] are the same as for [Arg.parse]. *)
 
+val align: (key * spec * doc) list -> (key * spec * doc) list;;
+(** Align the documentation strings by inserting spaces at the first
+    space, according to the length of the keyword.  Use a
+    space as the first character in a doc string if you want to
+    align the whole string.  The doc strings corresponding to
+    [Symbol] arguments are not aligned. *)
+
 val current : int ref
 (** Position (in {!Sys.argv}) of the argument being processed.  You can
     change this value, e.g. to force {!Arg.parse} to skip some arguments.
diff --git a/stdlib/buffer.ml b/stdlib/buffer.ml
index dcde111ecd..cafec4444c 100644
--- a/stdlib/buffer.ml
+++ b/stdlib/buffer.ml
@@ -11,6 +11,8 @@
 (*                                                                     *)
 (***********************************************************************)
 
+(* $Id$ *)
+
 (* Extensible buffers *)
 
 type t =
@@ -27,6 +29,22 @@ let create n =
 
 let contents b = String.sub b.buffer 0 b.position
 
+let sub b ofs len =
+  if ofs < 0 || len < 0 || ofs > b.position - len 
+  then invalid_arg "Buffer.sub"
+  else begin
+    let r = String.create len in
+    String.blit b.buffer ofs r 0 len;
+    r
+  end
+;;
+
+let nth b ofs = 
+  if ofs < 0 || ofs >= b.position then 
+   invalid_arg "Buffer.nth"
+  else String.get b.buffer ofs
+;;
+
 let length b = b.position
 
 let clear b = b.position <- 0
@@ -87,9 +105,9 @@ let closing = function
   | _ -> assert false;;
 
 (* opening and closing: open and close characters, typically ( and )
-   k balance of opening and closing chars
-   s the string where we are searching
-   start the index where we start the search *)
+   k: balance of opening and closing chars
+   s: the string where we are searching
+   start: the index where we start the search. *)
 let advance_to_closing opening closing k s start =
   let rec advance k i lim =
     if i >= lim then raise Not_found else
@@ -110,7 +128,7 @@ let advance_to_non_alpha s start =
     | _ -> i in
   advance start (String.length s);;
 
-(* We are just at the beginning of an ident in s, starting at start *)
+(* We are just at the beginning of an ident in s, starting at start. *)
 let find_ident s start =
   match s.[start] with
   (* Parenthesized ident ? *)
diff --git a/stdlib/buffer.mli b/stdlib/buffer.mli
index 73e02e299b..6fc76148ad 100644
--- a/stdlib/buffer.mli
+++ b/stdlib/buffer.mli
@@ -11,6 +11,8 @@
 (*                                                                     *)
 (***********************************************************************)
 
+(* $Id$ *)
+
 (** Extensible string buffers.
 
    This module implements string buffers that automatically expand
@@ -40,6 +42,16 @@ val contents : t -> string
 (** Return a copy of the current contents of the buffer.
    The buffer itself is unchanged. *)
 
+val sub : t -> int -> int -> string
+(** [Buffer.sub b off len] returns (a copy of) the substring of the
+current contents of the buffer [b] starting at offset [off] of length
+[len] bytes. May raise [Invalid_argument] if out of bounds request. The
+buffer itself is unaffected. *)
+
+val nth : t -> int -> char
+(** get the n-th character of the buffer. Raise [Invalid_argument] if
+index out of bounds *)
+
 val length : t -> int
 (** Return the number of characters currently contained in the buffer. *)
 
diff --git a/stdlib/camlinternalOO.ml b/stdlib/camlinternalOO.ml
index 95f07456f4..fff08b49f5 100644
--- a/stdlib/camlinternalOO.ml
+++ b/stdlib/camlinternalOO.ml
@@ -54,185 +54,36 @@ let params = {
 (**** Parameters ****)
 
 let step = Sys.word_size / 16
-let first_bucket = 0
-let bucket_size = 32                    (* Must be 256 or less *)
 let initial_object_size = 2
 
-(**** Index ****)
-
-type label = int
-
-let label_count = ref 0
-
-let next label =
-  incr label_count;
-  let label = label + step in
-  if label mod (step * bucket_size) = 0 then
-    label + step * (65536 - bucket_size)
-  else
-    label
-
-let decode label =
-  (label / 65536 / step, (label mod (step * bucket_size)) / step)
-
 (**** Items ****)
 
-type item
+type item = DummyA | DummyB | DummyC of int
 
 let dummy_item = (magic () : item)
 
-(**** Buckets ****)
-
-type bucket = item array
-
-let version = ref 0
-
-let set_bucket_version (bucket : bucket) =
-  bucket.(bucket_size) <- (magic !version : item)
-
-let bucket_version bucket =
-  (magic bucket.(bucket_size) : int)
-
-let bucket_list = ref []
-
-let empty_bucket = [| |]
-
-let new_bucket () =
-  let bucket = Array.create (bucket_size + 1) dummy_item in
-  set_bucket_version bucket;
-  bucket_list := bucket :: !bucket_list;
-  bucket
-
-let copy_bucket bucket =
-  let bucket = Array.copy bucket in
-  set_bucket_version bucket;
-  bucket.(bucket_size) <- (magic !version : item);
-  bucket_list := bucket :: !bucket_list;
-  bucket
-
-(**** Make a clean bucket ****)
-
-let new_filled_bucket pos methods =
-  let bucket = new_bucket () in
-  List.iter
-    (fun (lab, met) ->
-       let (buck, elem) = decode lab in
-       if buck = pos then
-         bucket.(elem) <- (magic met : item))
-    (List.rev methods);
-  bucket
-
-(**** Bucket merging ****)
-
-let small_buckets = ref (Array.create 10 [| |])
-let small_bucket_count = ref 0
-
-let insert_bucket bucket =
-  let length = Array.length !small_buckets in
-  if !small_bucket_count >= length then begin
-    let new_array = Array.create (2 * length) [| |] in
-    Array.blit !small_buckets 0 new_array 0 length;
-    small_buckets := new_array
-  end;
-  !small_buckets.(!small_bucket_count) <- bucket;
-  incr small_bucket_count
-
-let remove_bucket n =
-  !small_buckets.(n) <- !small_buckets.(!small_bucket_count - 1);
-  decr small_bucket_count
-
-let bucket_used b =
-  let n = ref 0 in
-  for i = 0 to bucket_size - 1 do
-    if b.(i) != dummy_item then incr n
-  done;
-  !n
-
-let small_bucket b = bucket_used b <= params.bucket_small_size
-
-exception Failed
-
-let rec except e =
-  function
-    [] -> []
-  | e'::l -> if e == e' then l else e'::(except e l)
-
-let merge_buckets b1 b2 =
-  for i = 0 to bucket_size - 1 do
-    if
-      (b2.(i) != dummy_item) && (b1.(i) != dummy_item) && (b2.(i) != b1.(i))
-    then
-      raise Failed
-  done;
-  for i = 0 to bucket_size - 1 do
-    if b2.(i) != dummy_item then
-      b1.(i) <- b2.(i)
-  done;
-  bucket_list := except b2 !bucket_list;
-  b1
-
-let prng = Random.State.make [| 0 |];;
-
-let rec choose bucket i =
-  if (i > 0) && (!small_bucket_count > 0) then begin
-    let n = Random.State.int prng !small_bucket_count in
-    if not (small_bucket !small_buckets.(n)) then begin
-      remove_bucket n; choose bucket i
-    end else
-      try
-        merge_buckets !small_buckets.(n) bucket
-      with Failed ->
-        choose bucket (i - 1)
-  end else begin
-    insert_bucket bucket;
-    bucket
-  end
-
-let compact b =
-  if
-    (b != empty_bucket) && (bucket_version b = !version) && (small_bucket b)
-  then
-    choose b params.retry_count
-  else
-    b
+(**** Types ****)
 
-let compact_buckets buckets =
-  for i = first_bucket to Array.length buckets - 1 do
-    buckets.(i) <- compact buckets.(i)
-  done
+type tag
+type label = int
+type closure = item
+type t = DummyA | DummyB | DummyC of int
+type obj = t array
+external ret : (obj -> 'a) -> closure = "%identity"
 
 (**** Labels ****)
 
-let first_label = first_bucket * 65536 * step
-
-let last_label = ref first_label
-let methods = Hashtbl.create 101
-
-let new_label () =
-  let label = !last_label in
-  last_label := next !last_label;
-  label
-
-let new_method met =
-  try
-    Hashtbl.find methods met
-  with Not_found ->
-    let label = new_label () in
-    Hashtbl.add methods met label;
-    label
-
-let public_method_label met =
-  try
-    Hashtbl.find methods met
-  with Not_found ->
-    invalid_arg "Oo.public_method_label"
-
-let new_anonymous_method =
-  new_label
-
-(**** Types ****)
-
-type obj = t array
+let public_method_label s : tag =
+  let accu = ref 0 in
+  for i = 0 to String.length s - 1 do
+    accu := 223 * !accu + Char.code s.[i]
+  done;
+  (* reduce to 31 bits *)
+  accu := !accu land (1 lsl 31 - 1);
+  (* make it signed for 64 bits architectures *)
+  let tag = if !accu > 0x3FFFFFFF then !accu - (1 lsl 31) else !accu in
+  (* Printf.eprintf "%s = %d\n" s tag; flush stderr; *)
+  magic tag
 
 (**** Sparse array ****)
 
@@ -247,7 +98,7 @@ type labs = bool Labs.t
 (* The compiler assumes that the first field of this structure is [size]. *)
 type table =
  { mutable size: int;
-   mutable buckets: bucket array;
+   mutable methods: closure array;
    mutable methods_by_name: meths;
    mutable methods_by_label: labs;
    mutable previous_states:
@@ -258,20 +109,31 @@ type table =
    mutable initializers: (obj -> unit) list }
 
 let dummy_table =
-  { buckets = [| |];
+  { methods = [| dummy_item |];
     methods_by_name = Meths.empty;
     methods_by_label = Labs.empty;
     previous_states = [];
     hidden_meths = [];
     vars = Vars.empty;
     initializers = [];
-    size = initial_object_size }
+    size = 0 }
 
 let table_count = ref 0
 
-let new_table () =
+let null_item : item = Obj.obj (Obj.field (Obj.repr 0n) 1)
+
+let rec fit_size n =
+  if n <= 2 then n else
+  fit_size ((n+1)/2) * 2
+
+let new_table pub_labels =
   incr table_count;
-  { buckets = [| |];
+  let len = Array.length pub_labels in
+  let methods = Array.create (len*2+2) null_item in
+  methods.(0) <- magic len;
+  methods.(1) <- magic (fit_size len * Sys.word_size / 8 - 1);
+  for i = 0 to len - 1 do methods.(i*2+3) <- magic pub_labels.(i) done;
+  { methods = methods;
     methods_by_name = Meths.empty;
     methods_by_label = Labs.empty;
     previous_states = [];
@@ -281,40 +143,42 @@ let new_table () =
     size = initial_object_size }
 
 let resize array new_size =
-  let old_size = Array.length array.buckets in
+  let old_size = Array.length array.methods in
   if new_size > old_size then begin
-    let new_buck = Array.create new_size empty_bucket in
-    Array.blit array.buckets 0 new_buck 0 old_size;
-    array.buckets <- new_buck
+    let new_buck = Array.create new_size null_item in
+    Array.blit array.methods 0 new_buck 0 old_size;
+    array.methods <- new_buck
  end
 
 let put array label element =
-  let (buck, elem) = decode label in
-  resize array (buck + 1);
-  let bucket = ref (array.buckets.(buck)) in
-  if !bucket == empty_bucket then begin
-    bucket := new_bucket ();
-    array.buckets.(buck) <- !bucket
-  end;
-  !bucket.(elem) <- element
+  resize array (label + 1);
+  array.methods.(label) <- element
 
 (**** Classes ****)
 
 let method_count = ref 0
 let inst_var_count = ref 0
 
-type t
+(* type t *)
 type meth = item
 
+let new_method table =
+  let index = Array.length table.methods in
+  resize table (index + 1);
+  index
+
 let get_method_label table name =
   try
     Meths.find name table.methods_by_name
   with Not_found ->
-    let label = new_anonymous_method () in
+    let label = new_method table in
     table.methods_by_name <- Meths.add name label table.methods_by_name;
     table.methods_by_label <- Labs.add label true table.methods_by_label;
     label
 
+let get_method_labels table names =
+  Array.map (get_method_label table) names
+
 let set_method table label element =
   incr method_count;
   if Labs.find label table.methods_by_label then
@@ -323,9 +187,8 @@ let set_method table label element =
     table.hidden_meths <- (label, element) :: table.hidden_meths
 
 let get_method table label =
-  try List.assoc label table.hidden_meths with Not_found ->
-  let (buck, elem) = decode label in
-  table.buckets.(buck).(elem)
+  try List.assoc label table.hidden_meths
+  with Not_found -> table.methods.(label)
 
 let to_list arr =
   if arr == magic 0 then [] else Array.to_list arr
@@ -403,25 +266,39 @@ let new_variables table names =
 let get_variable table name =
   Vars.find name table.vars
 
+let get_variables table names =
+  Array.map (get_variable table) names
+
 let add_initializer table f =
   table.initializers <- f::table.initializers
 
+(*
+module Keys = Map.Make(struct type t = tag array let compare = compare end)
+let key_map = ref Keys.empty
+let get_key tags : item =
+  try magic (Keys.find tags !key_map : tag array)
+  with Not_found ->
+    key_map := Keys.add tags tags !key_map;
+    magic tags
+*)
+
 let create_table public_methods =
-  let table = new_table () in
-  if public_methods != magic 0 then
-    Array.iter
-      (function met ->
-        let lab = new_method met in
-        table.methods_by_name  <- Meths.add met lab table.methods_by_name;
-        table.methods_by_label <- Labs.add lab true table.methods_by_label)
-      public_methods;
+  if public_methods == magic 0 then new_table [||] else
+  (* [public_methods] must be in ascending order for bytecode *)
+  let tags = Array.map public_method_label public_methods in
+  let table = new_table tags in
+  Array.iteri
+    (fun i met ->
+      let lab = i*2+2 in
+      table.methods_by_name  <- Meths.add met lab table.methods_by_name;
+      table.methods_by_label <- Labs.add lab true table.methods_by_label)
+    public_methods;
   table
 
 let init_class table =
   inst_var_count := !inst_var_count + table.size - 1;
-  if params.compact_table then
-    compact_buckets table.buckets;
-  table.initializers <- List.rev table.initializers
+  table.initializers <- List.rev table.initializers;
+  resize table (3 + magic table.methods.(1) * 16 / Sys.word_size)
 
 let inherits cla vals virt_meths concr_meths (_, super, _, env) top =
   narrow cla vals virt_meths concr_meths;
@@ -451,7 +328,7 @@ let create_object table =
   (* XXX Appel de [obj_block] *)
   let obj = Obj.new_block Obj.object_tag table.size in
   (* XXX Appel de [caml_modify] *)
-  Obj.set_field obj 0 (Obj.repr table.buckets);
+  Obj.set_field obj 0 (Obj.repr table.methods);
   set_id obj last_id;
   (Obj.obj obj)
 
@@ -460,7 +337,7 @@ let create_object_opt obj_0 table =
     (* XXX Appel de [obj_block] *)
     let obj = Obj.new_block Obj.object_tag table.size in
     (* XXX Appel de [caml_modify] *)
-    Obj.set_field obj 0 (Obj.repr table.buckets);
+    Obj.set_field obj 0 (Obj.repr table.methods);
     set_id obj last_id;
     (Obj.obj obj)
   end
@@ -490,17 +367,20 @@ let create_object_and_run_initializers obj_0 table =
   end
 
 (* Equivalent primitive below
-let send obj lab =
-  let (buck, elem) = decode lab in
-  (magic obj : (obj -> t) array array array).(0).(buck).(elem) obj
+let sendself obj lab =
+  (magic obj : (obj -> t) array array).(0).(lab) obj
 *)
-external send : obj -> label -> 'a = "%send"
+external send : obj -> tag -> 'a = "%send"
+external sendcache : obj -> tag -> t -> int -> 'a = "%sendcache"
+external sendself : obj -> label -> 'a = "%sendself"
+external get_public_method : obj -> tag -> closure
+    = "caml_get_public_method" "noalloc"
 
 (**** table collection access ****)
 
-type tables = Empty | Cons of table * tables * tables
+type tables = Empty | Cons of closure * tables * tables
 type mut_tables =
-    {key: table; mutable data: tables; mutable next: tables}
+    {key: closure; mutable data: tables; mutable next: tables}
 external mut : tables -> mut_tables = "%identity"
 
 let build_path n keys tables =
@@ -533,34 +413,61 @@ let lookup_tables root keys =
 
 (**** builtin methods ****)
 
-type closure = item
-external ret : (obj -> 'a) -> closure = "%identity"
-
 let get_const x = ret (fun obj -> x)
 let get_var n   = ret (fun obj -> Array.unsafe_get obj n)
-let get_env e n = ret (fun obj -> Obj.field (Array.unsafe_get obj e) n)
-let get_meth n  = ret (fun obj -> send obj n)
+let get_env e n =
+  ret (fun obj ->
+    Array.unsafe_get (Obj.magic (Array.unsafe_get obj e) : obj) n)
+let get_meth n  = ret (fun obj -> sendself obj n)
 let set_var n   = ret (fun obj x -> Array.unsafe_set obj n x)
 let app_const f x = ret (fun obj -> f x)
 let app_var f n   = ret (fun obj -> f (Array.unsafe_get obj n))
-let app_env f e n = ret (fun obj -> f (Obj.field (Array.unsafe_get obj e) n))
-let app_meth f n  = ret (fun obj -> f (send obj n))
+let app_env f e n =
+  ret (fun obj ->
+    f (Array.unsafe_get (Obj.magic (Array.unsafe_get obj e) : obj) n))
+let app_meth f n  = ret (fun obj -> f (sendself obj n))
 let app_const_const f x y = ret (fun obj -> f x y)
 let app_const_var f x n   = ret (fun obj -> f x (Array.unsafe_get obj n))
-let app_const_meth f x n = ret (fun obj -> f x (send obj n))
+let app_const_meth f x n = ret (fun obj -> f x (sendself obj n))
 let app_var_const f n x = ret (fun obj -> f (Array.unsafe_get obj n) x)
-let app_meth_const f n x = ret (fun obj -> f (send obj n) x)
+let app_meth_const f n x = ret (fun obj -> f (sendself obj n) x)
 let app_const_env f x e n =
-  ret (fun obj -> f x (Obj.field (Array.unsafe_get obj e) n))
+  ret (fun obj ->
+    f x (Array.unsafe_get (Obj.magic (Array.unsafe_get obj e) : obj) n))
 let app_env_const f e n x =
-  ret (fun obj -> f (Obj.field (Array.unsafe_get obj e) n) x)
-let meth_app_const n x = ret (fun obj -> (send obj n) x)
+  ret (fun obj ->
+    f (Array.unsafe_get (Obj.magic (Array.unsafe_get obj e) : obj) n) x)
+let meth_app_const n x = ret (fun obj -> (sendself obj n) x)
 let meth_app_var n m =
-  ret (fun obj -> (send obj n) (Array.unsafe_get obj m))
+  ret (fun obj -> (sendself obj n) (Array.unsafe_get obj m))
 let meth_app_env n e m =
-  ret (fun obj -> (send obj n) (Obj.field (Array.unsafe_get obj e) m))
+  ret (fun obj -> (sendself obj n)
+      (Array.unsafe_get (Obj.magic (Array.unsafe_get obj e) : obj) m))
 let meth_app_meth n m =
-  ret (fun obj -> (send obj n) (send obj m))
+  ret (fun obj -> (sendself obj n) (sendself obj m))
+let send_const m x c =
+  ret (fun obj -> sendcache x m (Array.unsafe_get obj 0) c)
+let send_var m n c =
+  ret (fun obj ->
+    sendcache (Obj.magic (Array.unsafe_get obj n) : obj) m
+      (Array.unsafe_get obj 0) c)
+let send_env m e n c =
+  ret (fun obj ->
+    sendcache
+      (Obj.magic (Array.unsafe_get
+                    (Obj.magic (Array.unsafe_get obj e) : obj) n) : obj)
+      m (Array.unsafe_get obj 0) c)
+let send_meth m n c =
+  ret (fun obj ->
+    sendcache (sendself obj n) m (Array.unsafe_get obj 0) c)
+let new_cache table =
+  let n = new_method table in
+  let n =
+    if n mod 2 = 0 || n > 2 + magic table.methods.(1) * 16 / Sys.word_size
+    then n else new_method table
+  in
+  table.methods.(n) <- Obj.magic 0;
+  n
 
 type impl =
     GetConst
@@ -583,23 +490,27 @@ type impl =
   | MethAppVar
   | MethAppEnv
   | MethAppMeth
-  | Closure of Obj.t
+  | SendConst
+  | SendVar
+  | SendEnv
+  | SendMeth
+  | Closure of closure
 
-let method_impl i arr =
+let method_impl table i arr =
   let next () = incr i; magic arr.(!i) in
   match next() with
-    GetConst -> let x : t = next() in ret (fun obj -> x)
+    GetConst -> let x : t = next() in get_const x
   | GetVar   -> let n = next() in get_var n
   | GetEnv   -> let e = next() and n = next() in get_env e n
   | GetMeth  -> let n = next() in get_meth n
   | SetVar   -> let n = next() in set_var n
-  | AppConst -> let f = next() and x = next() in ret (fun obj -> f x)
+  | AppConst -> let f = next() and x = next() in app_const f x
   | AppVar   -> let f = next() and n = next () in app_var f n
   | AppEnv   ->
       let f = next() and e = next() and n = next() in app_env f e n
   | AppMeth  -> let f = next() and n = next () in app_meth f n
   | AppConstConst ->
-      let f = next() and x = next() and y = next() in ret (fun obj -> f x y)
+      let f = next() and x = next() and y = next() in app_const_const f x y
   | AppConstVar ->
       let f = next() and x = next() and n = next() in app_const_var f x n
   | AppConstEnv ->
@@ -622,12 +533,21 @@ let method_impl i arr =
       let n = next() and e = next() and m = next() in meth_app_env n e m
   | MethAppMeth ->
       let n = next() and m = next() in meth_app_meth n m
+  | SendConst ->
+      let m = next() and x = next() in send_const m x (new_cache table)
+  | SendVar ->
+      let m = next() and n = next () in send_var m n (new_cache table)
+  | SendEnv ->
+      let m = next() and e = next() and n = next() in
+      send_env m e n (new_cache table)
+  | SendMeth ->
+      let m = next() and n = next () in send_meth m n (new_cache table)
   | Closure _ as clo -> magic clo
 
 let set_methods table methods =
   let len = Array.length methods and i = ref 0 in
   while !i < len do
-    let label = methods.(!i) and clo = method_impl i methods in
+    let label = methods.(!i) and clo = method_impl table i methods in
     set_method table label clo;
     incr i
   done
@@ -635,35 +555,8 @@ let set_methods table methods =
 (**** Statistics ****)
 
 type stats =
-  { classes: int; labels: int; methods: int; inst_vars: int; buckets: int;
-    distrib : int array; small_bucket_count: int; small_bucket_max: int }
-
-let distrib () =
-  let d = Array.create 32 0 in
-  List.iter
-    (function b ->
-       let n = bucket_used b in
-       d.(n - 1) <- d.(n - 1) + 1)
-    !bucket_list;
-  d
+  { classes: int; methods: int; inst_vars: int; }
 
 let stats () =
-  { classes = !table_count; labels = !label_count;
-    methods = !method_count; inst_vars = !inst_var_count;
-    buckets = List.length !bucket_list; distrib = distrib ();
-    small_bucket_count = !small_bucket_count;
-    small_bucket_max = Array.length !small_buckets  }
-
-let sort_buck lst =
-  List.map snd
-    (Sort.list (fun (n, _) (n', _) -> n <= n')
-       (List.map (function b -> (bucket_used b, b)) lst))
-
-let show_buckets () =
-  List.iter
-    (function b ->
-       for i = 0 to bucket_size - 1 do
-         print_char (if b.(i) == dummy_item then '.' else '*')
-       done;
-       print_newline ())
-    (sort_buck !bucket_list)
+  { classes = !table_count;
+    methods = !method_count; inst_vars = !inst_var_count; }
diff --git a/stdlib/camlinternalOO.mli b/stdlib/camlinternalOO.mli
index 0195d465f5..8b6c980f6a 100644
--- a/stdlib/camlinternalOO.mli
+++ b/stdlib/camlinternalOO.mli
@@ -17,22 +17,23 @@
     All functions in this module are for system use only, not for the
     casual user. *)
 
-(** {6 Methods} *)
-
-type label
-val new_method : string -> label
-val public_method_label : string -> label
-
 (** {6 Classes} *)
 
+type tag
+type label
 type table
 type meth
 type t
 type obj
+type closure
+val public_method_label : string -> tag
+val new_method : table -> label
 val new_variable : table -> string -> int
 val new_variables : table -> string array -> int
 val get_variable : table -> string -> int
+val get_variables : table -> string array -> int array
 val get_method_label : table -> string -> label
+val get_method_labels : table -> string array -> label array
 val get_method : table -> label -> meth
 val set_method : table -> label -> meth -> unit
 val set_methods : table -> label array -> unit
@@ -60,17 +61,19 @@ val create_object_opt : obj -> table -> obj
 val run_initializers : obj -> table -> unit
 val run_initializers_opt : obj -> obj -> table -> obj
 val create_object_and_run_initializers : obj -> table -> obj
-external send : obj -> label -> t = "%send"
+external send : obj -> tag -> t = "%send"
+external sendcache : obj -> tag -> t -> int -> t = "%sendcache"
+external sendself : obj -> label -> t = "%sendself"
+external get_public_method : obj -> tag -> closure
+    = "caml_get_public_method" "noalloc"
 
 (** {6 Table cache} *)
 
 type tables
-val lookup_tables : tables -> table array -> tables
+val lookup_tables : tables -> closure array -> tables
 
 (** {6 Builtins to reduce code size} *)
 
-open Obj
-type closure
 val get_const : t -> closure
 val get_var : int -> closure
 val get_env : int -> int -> closure
@@ -91,6 +94,10 @@ val meth_app_const : label -> t -> closure
 val meth_app_var : label -> int -> closure
 val meth_app_env : label -> int -> int -> closure
 val meth_app_meth : label -> label -> closure
+val send_const : tag -> obj -> int -> closure
+val send_var : tag -> int -> int -> closure
+val send_env : tag -> int -> int -> int -> closure
+val send_meth : tag -> label -> int -> closure
 
 type impl =
     GetConst
@@ -113,10 +120,15 @@ type impl =
   | MethAppVar
   | MethAppEnv
   | MethAppMeth
-  | Closure of t
+  | SendConst
+  | SendVar
+  | SendEnv
+  | SendMeth
+  | Closure of closure
 
 (** {6 Parameters} *)
 
+(* currently disabled *)
 type params =
   { mutable compact_table : bool;
     mutable copy_parent : bool;
@@ -130,12 +142,6 @@ val params : params
 
 type stats =
   { classes : int; 
-    labels : int; 
     methods : int; 
-    inst_vars : int; 
-    buckets : int;
-    distrib : int array; 
-    small_bucket_count : int; 
-    small_bucket_max : int }
+    inst_vars : int }
 val stats : unit -> stats
-val show_buckets : unit -> unit
diff --git a/stdlib/filename.ml b/stdlib/filename.ml
index 82dce717bd..7d6887eaf4 100644
--- a/stdlib/filename.ml
+++ b/stdlib/filename.ml
@@ -28,11 +28,9 @@ let generic_quote quotequote s =
 module Unix = struct
   let current_dir_name = "."
   let parent_dir_name = ".."
-  let concat dirname filename =
-    let l = String.length dirname in
-    if l = 0 || dirname.[l-1] = '/'
-    then dirname ^ filename
-    else dirname ^ "/" ^ filename
+  let dir_sep = "/"
+  let is_dir_sep s i = s.[i] = '/'
+  let rindex_dir_sep s = String.rindex s '/'
   let is_relative n = String.length n < 1 || n.[0] <> '/';;
   let is_implicit n =
     is_relative n
@@ -42,19 +40,6 @@ module Unix = struct
     String.length name >= String.length suff &&
     String.sub name (String.length name - String.length suff)
                     (String.length suff) = suff
-  let basename name =
-    try
-      let p = String.rindex name '/' + 1 in
-      String.sub name p (String.length name - p)
-    with Not_found ->
-      name
-  let dirname name =
-    try
-      match String.rindex name '/' with
-        0 -> "/"
-      | n -> String.sub name 0 n
-    with Not_found ->
-      "."
   let temporary_directory =
     try Sys.getenv "TMPDIR" with Not_found -> "/tmp"
   let quote = generic_quote "'\\''"  
@@ -63,11 +48,14 @@ end
 module Win32 = struct
   let current_dir_name = "."
   let parent_dir_name = ".."
-  let concat dirname filename =
-    let l = String.length dirname in
-    if l = 0 || (let c = dirname.[l-1] in c = '/' || c = '\\' || c = ':')
-    then dirname ^ filename
-    else dirname ^ "\\" ^ filename
+  let dir_sep = "\\"
+  let is_dir_sep s i = let c = s.[i] in c = '/' || c = '\\' || c = ':'
+  let rindex_dir_sep s =
+    let rec pos i =
+      if i < 0 then raise Not_found
+      else if (let c = s.[i] in c = '/' || c = '\\' || c = ':') then i
+      else pos (i - 1)
+    in pos (String.length s - 1)
   let is_relative n =
     (String.length n < 1 || n.[0] <> '/')
     && (String.length n < 1 || n.[0] <> '\\')
@@ -83,29 +71,6 @@ module Win32 = struct
    (let s = String.sub name (String.length name - String.length suff)
                             (String.length suff) in
     String.lowercase s = String.lowercase suff)
-  let rindexsep s =
-    let rec pos i =
-      if i < 0 then raise Not_found
-      else if (let c = s.[i] in c = '/' || c = '\\' || c = ':') then i
-      else pos (i - 1)
-    in pos (String.length s - 1)
-  let basename name =
-    try
-      let p = rindexsep name + 1 in
-      String.sub name p (String.length name - p)
-    with Not_found ->
-      name
-  let dirname name =
-    try
-      match rindexsep name with
-        0 -> "\\"
-      | n ->
-          let n =
-            if name.[n] = ':' || (n > 0 && name.[n-1] = ':')
-            then n+1 else n in
-          String.sub name 0 n
-    with Not_found ->
-      "."
   let temporary_directory =
     try Sys.getenv "TEMP" with Not_found -> "."
   let quote s =
@@ -127,57 +92,67 @@ end
 module Cygwin = struct
   let current_dir_name = "."
   let parent_dir_name = ".."
-  let concat dirname filename =
-    let l = String.length dirname in
-    if l = 0 || (let c = dirname.[l-1] in c = '/' || c = '\\' || c = ':')
-    then dirname ^ filename
-    else dirname ^ "/" ^ filename
+  let dir_sep = "/"
+  let is_dir_sep = Win32.is_dir_sep
+  let rindex_dir_sep = Win32.rindex_dir_sep
   let is_relative = Win32.is_relative
   let is_implicit = Win32.is_implicit
   let check_suffix = Win32.check_suffix
-  let basename = Win32.basename
-  let dirname name =
-    try
-      match Win32.rindexsep name with
-        0 -> "/"
-      | n ->
-          let n =
-            if name.[n] = ':' || (n > 0 && name.[n-1] = ':')
-            then n+1 else n in
-          String.sub name 0 n
-    with Not_found ->
-      "."
   let temporary_directory = Unix.temporary_directory
   let quote = Unix.quote
 end
 
-let (current_dir_name, parent_dir_name, concat, is_relative, is_implicit,
-     check_suffix, basename, dirname, temporary_directory, quote) =
+let (current_dir_name, parent_dir_name, dir_sep, is_dir_sep, rindex_dir_sep,
+     is_relative, is_implicit, check_suffix, temporary_directory, quote) =
   match Sys.os_type with
     "Unix" ->
-      (Unix.current_dir_name, Unix.parent_dir_name, Unix.concat,
+      (Unix.current_dir_name, Unix.parent_dir_name, Unix.dir_sep, 
+       Unix.is_dir_sep, Unix.rindex_dir_sep,
        Unix.is_relative, Unix.is_implicit, Unix.check_suffix,
-       Unix.basename, Unix.dirname, Unix.temporary_directory, Unix.quote)
+       Unix.temporary_directory, Unix.quote)
   | "Win32" ->
-      (Win32.current_dir_name, Win32.parent_dir_name, Win32.concat,
+      (Win32.current_dir_name, Win32.parent_dir_name, Win32.dir_sep, 
+       Win32.is_dir_sep, Win32.rindex_dir_sep,
        Win32.is_relative, Win32.is_implicit, Win32.check_suffix,
-       Win32.basename, Win32.dirname, Win32.temporary_directory, Win32.quote)
+       Win32.temporary_directory, Win32.quote)
   | "Cygwin" ->
-      (Cygwin.current_dir_name, Cygwin.parent_dir_name, Cygwin.concat,
+      (Cygwin.current_dir_name, Cygwin.parent_dir_name, Cygwin.dir_sep, 
+       Cygwin.is_dir_sep, Cygwin.rindex_dir_sep,
        Cygwin.is_relative, Cygwin.is_implicit, Cygwin.check_suffix,
-       Cygwin.basename, Cygwin.dirname, 
        Cygwin.temporary_directory, Cygwin.quote)
   | _ -> assert false
 
+let concat dirname filename =
+  let l = String.length dirname in
+  if l = 0 || is_dir_sep dirname (l-1)
+  then dirname ^ filename
+  else dirname ^ dir_sep ^ filename
+
+let basename name =
+  try
+    let p = rindex_dir_sep name + 1 in
+    String.sub name p (String.length name - p)
+  with Not_found ->
+    name
+
+let dirname name =
+  try
+    match rindex_dir_sep name with
+      0 -> dir_sep
+    | n -> String.sub name 0 n
+  with Not_found ->
+    current_dir_name
+
 let chop_suffix name suff =
   let n = String.length name - String.length suff in
   if n < 0 then invalid_arg "Filename.chop_suffix" else String.sub name 0 n
 
 let chop_extension name =
-  try
-    String.sub name 0 (String.rindex name '.')
-  with Not_found ->
-    invalid_arg "Filename.chop_extension"
+  let rec search_dot i =
+    if i < 0 || is_dir_sep name i then invalid_arg "Filename.chop_extension"
+    else if name.[i] = '.' then String.sub name 0 i
+    else search_dot (i - 1) in
+  search_dot (String.length name - 1)
 
 external open_desc: string -> open_flag list -> int -> int = "caml_sys_open"
 external close_desc: int -> unit = "caml_sys_close"
diff --git a/stdlib/filename.mli b/stdlib/filename.mli
index 2d0d34396d..086775f5e9 100644
--- a/stdlib/filename.mli
+++ b/stdlib/filename.mli
@@ -48,10 +48,11 @@ val chop_suffix : string -> string -> string
 
 val chop_extension : string -> string
 (** Return the given file name without its extension. The extension
-   is the shortest suffix starting with a period, [.xyz] for instance.
+   is the shortest suffix starting with a period and not including
+   a directory separator, [.xyz] for instance.
 
    Raise [Invalid_argument] if the given name does not contain
-   a period. *)
+   an extension. *)
 
 val basename : string -> string
 (** Split a file name into directory name / base file name.
diff --git a/stdlib/format.mli b/stdlib/format.mli
index a8c83bd1b6..3526e2365b 100644
--- a/stdlib/format.mli
+++ b/stdlib/format.mli
@@ -20,6 +20,9 @@
    at specified break hints, and indents lines according to the box
    structure.
 
+   For a gentle introduction to the basics of prety-printing using
+   [Format], read the FAQ at [http://caml.inria.fr/FAQ/format-eng.html]. 
+
    Warning: the material output by the following functions is delayed
    in the pretty-printer queue in order to compute the proper line
    breaking. Hence, you should not mix calls to the printing functions
@@ -584,7 +587,9 @@ val fprintf : formatter -> ('a, formatter, unit) format -> 'a;;
      [nspaces] and [offset] parameters of the break may be
      optionally specified with the following syntax: 
      the [<] character, followed by an integer [nspaces] value,
-     then an integer offset, and a closing [>] character. 
+     then an integer offset, and a closing [>] character.
+     If no parameters are provided, the good break defaults to a
+     space.
    - [@?]: flush the pretty printer as with [print_flush ()].
      This is equivalent to the conversion [%!].
    - [@.]: flush the pretty printer and output a new line, as with
diff --git a/stdlib/gc.ml b/stdlib/gc.ml
index e4a15aea66..7299ff867c 100644
--- a/stdlib/gc.ml
+++ b/stdlib/gc.ml
@@ -78,6 +78,7 @@ let allocated_bytes () =
 ;;
 
 external finalise : ('a -> unit) -> 'a -> unit = "caml_final_register";;
+external finalise_release : unit -> unit = "caml_final_release";;
 
 
 type alarm = bool ref;;
diff --git a/stdlib/gc.mli b/stdlib/gc.mli
index 491faab393..bafa8ed9f7 100644
--- a/stdlib/gc.mli
+++ b/stdlib/gc.mli
@@ -188,14 +188,15 @@ val finalise : ('a -> unit) -> 'a -> unit
    be registered for the same value, or even several instances of the
    same function.  Each instance will be called once (or never,
    if the program terminates before [v] becomes unreachable).
-   
-  
-   A number of pitfalls are associated with finalised values:
-   finalisation functions are called asynchronously, sometimes
-   even during the execution of other finalisation functions.
-   In a multithreaded program, finalisation functions are called
-   from any thread, thus they must not acquire any mutex.
 
+   The GC will call the finalisation functions in the order of
+   deallocation.  When several values become unreachable at the
+   same time (i.e. during the same GC cycle), the finalisation
+   functions will be called in the reverse order of the corresponding
+   calls to [finalise].  If [finalise] is called in the same order
+   as the values are allocated, that means each value is finalised
+   before the values it depends upon.  Of course, this becomes
+   false if additional dependencies are introduced by assignments.
 
    Anything reachable from the closure of finalisation functions
    is considered reachable, so the following code will not work
@@ -232,10 +233,14 @@ val finalise : ('a -> unit) -> 'a -> unit
    
    The results of calling {!String.make}, {!String.create},
    {!Array.make}, and {!Pervasives.ref} are guaranteed to be
-   heap-allocated and non-constant
-   except when the length argument is [0].
+   heap-allocated and non-constant except when the length argument is [0].
 *)
 
+val finalise_release : unit -> unit;;
+(** A finalisation function may call [finalise_release] to tell the
+    GC that it can launch the next finalisation function without waiting
+    for the current one to return. *)
+
 type alarm
 (** An alarm is a piece of data that calls a user function at the end of
    each major GC cycle.  The following functions are provided to create
diff --git a/stdlib/hashtbl.ml b/stdlib/hashtbl.ml
index 0169f747ae..225aa6be78 100644
--- a/stdlib/hashtbl.ml
+++ b/stdlib/hashtbl.ml
@@ -44,6 +44,8 @@ let copy h =
   { size = h.size;
     data = Array.copy h.data }
 
+let length h = h.size
+
 let resize hashfun tbl =
   let odata = tbl.data in
   let osize = Array.length odata in
@@ -184,6 +186,7 @@ module type S =
     val mem : 'a t -> key -> bool
     val iter: (key -> 'a -> unit) -> 'a t -> unit
     val fold: (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
+    val length: 'a t -> int
   end
 
 module Make(H: HashedType): (S with type key = H.t) =
@@ -272,4 +275,7 @@ module Make(H: HashedType): (S with type key = H.t) =
 
     let iter = iter
     let fold = fold
+    let length = length
   end
+
+(* eof $Id$ *)
diff --git a/stdlib/hashtbl.mli b/stdlib/hashtbl.mli
index fcb296a7ce..d6434ade79 100644
--- a/stdlib/hashtbl.mli
+++ b/stdlib/hashtbl.mli
@@ -35,6 +35,7 @@ val create : int -> ('a, 'b) t
 val clear : ('a, 'b) t -> unit
 (** Empty a hash table. *)
 
+
 val add : ('a, 'b) t -> 'a -> 'b -> unit
 (** [Hashtbl.add tbl x y] adds a binding of [x] to [y] in table [tbl].
    Previous bindings for [x] are not removed, but simply
@@ -91,6 +92,12 @@ val fold : ('a -> 'b -> 'c -> 'c) -> ('a, 'b) t -> 'c -> 'c
    the most recent binding is passed first. *)
 
 
+val length : ('a, 'b) t -> int
+(** [Hashtbl.length tbl] returns the number of bindings in [tbl]. 
+   Multiple bindings are counted multiply, so [Hashtbl.length] 
+   gives the number of times [Hashtbl.iter] calls it first argument. *)
+
+
 (** {6 Functorial interface} *)
 
 
@@ -130,6 +137,7 @@ module type S =
     val mem : 'a t -> key -> bool
     val iter : (key -> 'a -> unit) -> 'a t -> unit
     val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
+    val length : 'a t -> int
   end
 (** The output signature of the functor {!Hashtbl.Make}. *)
 
diff --git a/stdlib/map.ml b/stdlib/map.ml
index 26c4d23c00..81b3396f33 100644
--- a/stdlib/map.ml
+++ b/stdlib/map.ml
@@ -24,6 +24,7 @@ module type S =
     type key
     type +'a t
     val empty: 'a t
+    val is_empty: 'a t -> bool
     val add: key -> 'a -> 'a t -> 'a t
     val find: key -> 'a t -> 'a
     val remove: key -> 'a t -> 'a t
@@ -32,6 +33,8 @@ module type S =
     val map: ('a -> 'b) -> 'a t -> 'b t
     val mapi: (key -> 'a -> 'b) -> 'a t -> 'b t
     val fold: (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
+    val compare: ('a -> 'a -> int) -> 'a t -> 'a t -> int
+    val equal: ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
   end
 
 module Make(Ord: OrderedType) = struct
@@ -42,8 +45,6 @@ module Make(Ord: OrderedType) = struct
         Empty
       | Node of 'a t * key * 'a * 'a t * int
 
-    let empty = Empty
-
     let height = function
         Empty -> 0
       | Node(_,_,_,_,h) -> h
@@ -82,6 +83,10 @@ module Make(Ord: OrderedType) = struct
       end else
         Node(l, x, d, r, (if hl >= hr then hl + 1 else hr + 1))
 
+    let empty = Empty
+
+    let is_empty = function Empty -> true | _ -> false
+
     let rec add x data = function
         Empty ->
           Node(Empty, x, data, Empty, 1)
@@ -158,4 +163,36 @@ module Make(Ord: OrderedType) = struct
       | Node(l, v, d, r, _) ->
           fold f l (f v d (fold f r accu))
 
+    type 'a enumeration = End | More of key * 'a * 'a t * 'a enumeration
+
+    let rec cons_enum m e =
+      match m with
+        Empty -> e
+      | Node(l, v, d, r, _) -> cons_enum l (More(v, d, r, e))
+
+    let compare cmp m1 m2 =
+      let rec compare_aux e1 e2 =
+          match (e1, e2) with
+          (End, End) -> 0
+        | (End, _)  -> -1
+        | (_, End) -> 1
+        | (More(v1, d1, r1, e1), More(v2, d2, r2, e2)) ->
+            let c = Ord.compare v1 v2 in
+            if c <> 0 then c else
+            let c = cmp d1 d2 in
+            if c <> 0 then c else
+            compare_aux (cons_enum r1 e1) (cons_enum r2 e2)
+      in compare_aux (cons_enum m1 End) (cons_enum m2 End)
+
+    let equal cmp m1 m2 =
+      let rec equal_aux e1 e2 =
+          match (e1, e2) with
+          (End, End) -> true
+        | (End, _)  -> false
+        | (_, End) -> false
+        | (More(v1, d1, r1, e1), More(v2, d2, r2, e2)) ->
+            Ord.compare v1 v2 = 0 && cmp d1 d2 &&
+            equal_aux (cons_enum r1 e1) (cons_enum r2 e2)
+      in equal_aux (cons_enum m1 End) (cons_enum m2 End)
+
 end
diff --git a/stdlib/map.mli b/stdlib/map.mli
index ea8cc68f4f..71d6e269c1 100644
--- a/stdlib/map.mli
+++ b/stdlib/map.mli
@@ -49,6 +49,9 @@ module type S =
     val empty: 'a t
     (** The empty map. *)
 
+    val is_empty: 'a t -> bool
+    (** Test whether a map is empty or not. *)
+
     val add: key -> 'a -> 'a t -> 'a t
     (** [add x y m] returns a map containing the same bindings as
        [m], plus a binding of [x] to [y]. If [x] was already bound
@@ -90,6 +93,16 @@ module type S =
        where [k1 ... kN] are the keys of all bindings in [m]
        (in increasing order), and [d1 ... dN] are the associated data. *)
 
+    val compare: ('a -> 'a -> int) -> 'a t -> 'a t -> int
+    (** Total ordering between maps.  The first argument is a total ordering
+        used to compare data associated with equal keys in the two maps. *)
+
+    val equal: ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
+    (** [equal cmp m1 m2] tests whether the maps [m1] and [m2] are
+       equal, that is, contain equal keys and associate them with
+       equal data.  [cmp] is the equality predicate used to compare
+       the data associated with the keys. *)
+
   end
 (** Output signature of the functor {!Map.Make}. *)
 
diff --git a/stdlib/moreLabels.mli b/stdlib/moreLabels.mli
index 6a690470cb..fbf848cba8 100644
--- a/stdlib/moreLabels.mli
+++ b/stdlib/moreLabels.mli
@@ -38,6 +38,7 @@ module Hashtbl : sig
   val fold :
       f:(key:'a -> data:'b -> 'c -> 'c) ->
         ('a, 'b) t -> init:'c -> 'c
+  val length : ('a, 'b) t -> int
   module type HashedType = Hashtbl.HashedType
   module type S =
     sig
@@ -56,6 +57,7 @@ module Hashtbl : sig
       val fold :
           f:(key:key -> data:'a -> 'b -> 'b) ->
           'a t -> init:'b -> 'b
+      val length : 'a t -> int
     end
   module Make : functor (H : HashedType) -> S with type key = H.t
   val hash : 'a -> int
@@ -70,6 +72,7 @@ module Map : sig
       type key
       and (+'a) t
       val empty : 'a t
+      val is_empty: 'a t -> bool
       val add : key:key -> data:'a -> 'a t -> 'a t
       val find : key -> 'a t -> 'a
       val remove : key -> 'a t -> 'a t
@@ -80,7 +83,9 @@ module Map : sig
       val fold :
           f:(key:key -> data:'a -> 'b -> 'b) ->
           'a t -> init:'b -> 'b
-    end
+      val compare: cmp:('a -> 'a -> int) -> 'a t -> 'a t -> int
+      val equal: cmp:('a -> 'a -> bool) -> 'a t -> 'a t -> bool
+  end
   module Make : functor (Ord : OrderedType) -> S with type key = Ord.t
 end
 
@@ -113,6 +118,7 @@ module Set : sig
       val min_elt : t -> elt
       val max_elt : t -> elt
       val choose : t -> elt
+      val split: elt -> t -> t * bool * t
     end
   module Make : functor (Ord : OrderedType) -> S with type elt = Ord.t
 end
diff --git a/stdlib/oo.ml b/stdlib/oo.ml
index e8795d8573..c9ec64ae44 100644
--- a/stdlib/oo.ml
+++ b/stdlib/oo.ml
@@ -15,5 +15,5 @@
 
 let copy = CamlinternalOO.copy
 external id : < .. > -> int = "%field1"
-let new_method = CamlinternalOO.new_method
+let new_method = CamlinternalOO.public_method_label
 let public_method_label = CamlinternalOO.public_method_label
diff --git a/stdlib/oo.mli b/stdlib/oo.mli
index c18bfa51e4..b3111ce857 100644
--- a/stdlib/oo.mli
+++ b/stdlib/oo.mli
@@ -25,5 +25,5 @@ external id : < .. > -> int = "%field1"
 
 (**/**)
 (** For internal use (CamlIDL) *)
-val new_method : string -> CamlinternalOO.label
-val public_method_label : string -> CamlinternalOO.label
+val new_method : string -> CamlinternalOO.tag
+val public_method_label : string -> CamlinternalOO.tag
diff --git a/stdlib/parsing.mli b/stdlib/parsing.mli
index 6045c18d36..c6dc8e3212 100644
--- a/stdlib/parsing.mli
+++ b/stdlib/parsing.mli
@@ -30,7 +30,7 @@ val rhs_start : int -> int
 (** Same as {!Parsing.symbol_start} and {!Parsing.symbol_end}, but
    return the offset of the string matching the [n]th item on the
    right-hand side of the rule, where [n] is the integer parameter
-   to [lhs_start] and [lhs_end]. [n] is 1 for the leftmost item. *)
+   to [rhs_start] and [rhs_end]. [n] is 1 for the leftmost item. *)
 
 val rhs_end : int -> int
 (** See {!Parsing.rhs_start}. *)
diff --git a/stdlib/pervasives.mli b/stdlib/pervasives.mli
index 2561cc4cab..0b678ca28f 100644
--- a/stdlib/pervasives.mli
+++ b/stdlib/pervasives.mli
@@ -603,7 +603,9 @@ val output_byte : out_channel -> int -> unit
    256. *)
 
 val output_binary_int : out_channel -> int -> unit
-(** Write one integer in binary format on the given output channel.
+(** Write one integer in binary format (4 bytes, big-endian)
+   on the given output channel.
+   The given integer is taken modulo 2{^32}.
    The only reliable way to read it back is through the
    {!Pervasives.input_binary_int} function. The format is compatible across
    all machines for a given version of Objective Caml. *)
@@ -623,7 +625,9 @@ val seek_out : out_channel -> int -> unit
    the behavior is unspecified. *)
 
 val pos_out : out_channel -> int
-(** Return the current writing position for the given channel. *)
+(** Return the current writing position for the given channel.  Does
+    not work on channels opened with the [Open_append] flag (returns
+    unspecified results). *)
 
 val out_channel_length : out_channel -> int
 (** Return the total length (number of characters) of the
@@ -713,8 +717,8 @@ val input_byte : in_channel -> int
    Raise [End_of_file] if an end of file was reached. *)
 
 val input_binary_int : in_channel -> int
-(** Read an integer encoded in binary format from the given input
-   channel. See {!Pervasives.output_binary_int}.
+(** Read an integer encoded in binary format (4 bytes, big-endian)
+   from the given input channel. See {!Pervasives.output_binary_int}.
    Raise [End_of_file] if an end of file was reached while reading the
    integer. *)
 
diff --git a/stdlib/scanf.ml b/stdlib/scanf.ml
index 7413e21493..78adcc706a 100644
--- a/stdlib/scanf.ml
+++ b/stdlib/scanf.ml
@@ -115,8 +115,9 @@ type scanbuf = {
   file_name : file_name;
 };;
 
-(* Reads a new character from input buffer, sets the end of file
-   condition if necessary. *)
+(* Reads a new character from input buffer.  Next_char never fails,
+   even in case of end of input: it then simply sets the end of file
+   condition. *)
 let next_char ib =
   try
    let c = ib.get_next_char () in
@@ -264,8 +265,9 @@ let check_char_in range ib =
 (* Checking that [c] is indeed in the input, then skip it. *)
 let check_char ib c =
   let ci = Scanning.checked_peek_char ib in
-  if ci == c then Scanning.next_char ib else
-  bad_input (Printf.sprintf "looking for %C, found %C" c ci);;
+  if ci != c
+  then bad_input (Printf.sprintf "looking for %C, found %C" c ci)
+  else Scanning.next_char ib;;
 
 (* Extracting tokens from ouput token buffer. *)
 
@@ -315,11 +317,20 @@ let token_int64 conv ib = int64_of_string (token_int_literal conv ib);;
 
 (* Scanning numbers. *)
 
-(* The decimal case is optimized. *)
+(* Digits scanning functions suppose that one character has been
+   checked and is available, since they return at end of file with the
+   currently found token selected. The digits scanning functions scan
+   a possibly empty sequence of digits, (hence a successful scanning
+   from one of those functions does not imply that the token is a
+   well-formed number: to get a true number, it is mandatory to check
+   that at least one digit is available before calling a digit
+   scanning function). *)
+
+(* The decimal case is treated especially for optimization purposes. *)
 let scan_decimal_digits max ib =
   let rec loop inside max =
     if max = 0 || Scanning.eof ib then max else
-    match Scanning.checked_peek_char ib with
+    match Scanning.cautious_peek_char ib with
     | '0' .. '9' as c ->
         let max = Scanning.store_char ib c max in
         loop true max
@@ -329,11 +340,12 @@ let scan_decimal_digits max ib =
     | c -> max in
   loop false max;;
 
-(* Other cases uses a predicate argument to scan_digits. *)
+(* To scan numbers from other bases, we use a predicate argument to
+   scan_digits. *)
 let scan_digits digitp max ib =
   let rec loop inside max =
     if max = 0 || Scanning.eof ib then max else
-    match Scanning.checked_peek_char ib with
+    match Scanning.cautious_peek_char ib with
     | c when digitp c ->
        let max = Scanning.store_char ib c max in
        loop true max
@@ -343,28 +355,41 @@ let scan_digits digitp max ib =
     | _ -> max in
   loop false max;;
 
-let scan_binary_digits =
-  let is_binary_digit = function
+let scan_digits_plus digitp max ib =
+  let c = Scanning.checked_peek_char ib in
+  if digitp c then
+    let max = Scanning.store_char ib c max in
+    scan_digits digitp max ib
+  else bad_input_char c;;
+
+let is_binary_digit = function
   | '0' .. '1' -> true
-  | _ -> false in
-  scan_digits is_binary_digit;;
+  | _ -> false;;
 
-let scan_octal_digits =
-  let is_octal_digit = function
+let scan_binary_digits = scan_digits is_binary_digit;;
+let scan_binary_int = scan_digits_plus is_binary_digit;;
+
+let is_octal_digit = function
   | '0' .. '7' -> true
-  | _ -> false in
-  scan_digits is_octal_digit;;
+  | _ -> false;;
+
+let scan_octal_digits = scan_digits is_octal_digit;;
+let scan_octal_int = scan_digits_plus is_octal_digit;;
 
-let scan_hexadecimal_digits =
-  let is_hexa_digit = function
+let is_hexa_digit = function
   | '0' .. '9' | 'a' .. 'f' | 'A' .. 'F' -> true
-  | _ -> false in
-  scan_digits is_hexa_digit;;
+  | _ -> false;;
+
+let scan_hexadecimal_digits = scan_digits is_hexa_digit;;
+let scan_hexadecimal_int = scan_digits_plus is_hexa_digit;;
 
-(* Decimal integers. *)
+(* Scan a decimal integer. *)
 let scan_unsigned_decimal_int max ib =
-  if max = 0 || Scanning.eof ib then bad_input "decimal digit" else
-  scan_decimal_digits max ib;;
+  match Scanning.checked_peek_char ib with
+  | '0' .. '9' as c ->
+      let max = Scanning.store_char ib c max in
+      scan_decimal_digits max ib
+  | c -> bad_input_char c;;
 
 let scan_sign max ib =
   let c = Scanning.checked_peek_char ib in
@@ -392,28 +417,27 @@ let scan_unsigned_int max ib =
       | 'o' -> scan_octal_digits (Scanning.store_char ib c max) ib
       | 'b' -> scan_binary_digits (Scanning.store_char ib c max) ib
       | c -> scan_decimal_digits max ib end
-  | c -> scan_decimal_digits max ib;;
+  | c -> scan_unsigned_decimal_int max ib;;
 
 let scan_optionally_signed_int max ib =
   let max = scan_sign max ib in
-  if max = 0 || Scanning.eof ib then bad_input "bad int" else
   scan_unsigned_int max ib;;
 
-let scan_int conv max ib =
+let scan_int_conv conv max ib =
   match conv with
-  | 'b' -> scan_binary_digits max ib
+  | 'b' -> scan_binary_int max ib
   | 'd' -> scan_optionally_signed_decimal_int max ib
   | 'i' -> scan_optionally_signed_int max ib
-  | 'o' -> scan_octal_digits max ib
+  | 'o' -> scan_octal_int max ib
   | 'u' -> scan_unsigned_decimal_int max ib
-  | 'x' | 'X' -> scan_hexadecimal_digits max ib
+  | 'x' | 'X' -> scan_hexadecimal_int max ib
   | c -> 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 || Scanning.eof ib then max else
-  scan_unsigned_decimal_int max ib;;
+  scan_decimal_digits max ib;;
 
 (* Exp part is optional and can be reduced to 0 digits. *)
 let scan_exp_part max ib =
@@ -424,8 +448,17 @@ let scan_exp_part max ib =
      scan_optionally_signed_decimal_int (Scanning.store_char ib c max) ib
   | _ -> max;;
 
+(* An optional sign followed by a possibly empty sequence of decimal digits. *)
+let scan_optionally_signed_decimal_digits max ib =
+  let max = scan_sign max ib in
+  scan_decimal_digits max ib;;
+
+(* Scan the integer part of a floating point number, (not using the
+   Caml lexical convention since the integer part can be empty). *)
+let scan_int_part = scan_optionally_signed_decimal_digits;;
+
 let scan_float max ib =
-  let max = scan_optionally_signed_decimal_int max ib in
+  let max = scan_int_part max ib in
   if max = 0 || Scanning.eof ib then max else
   let c = Scanning.peek_char ib in
   match c with
@@ -448,7 +481,7 @@ let scan_Float max ib =
      scan_exp_part max ib
   | c -> bad_float ();;
 
-(* Scan a regular string: it stops with a space or one of the
+(* Scan a regular string: stops when encountering a space or one of the
    characters in stp. It also stops when the maximum number of
    characters has been read.*)
 let scan_string stp max ib =
@@ -630,7 +663,7 @@ let make_bv bit set =
     if i <= lim then
     match set.[i] with
     | '-' when rp ->
-       (* if i = 0 then rp is false (since the initial call is loop false 0)
+       (* if i = 0 then rp is false (since the initial call is loop bit false 0)
           hence i >= 1 and the following is safe. *)
        let c1 = set.[i - 1] in
        let i = i + 1 in
@@ -665,6 +698,7 @@ let make_setp stp char_set =
           (fun c -> if c == p1 || c == p2 then 1 else 0)
       | 3 ->
           let p1 = set.[0] and p2 = set.[1] and p3 = set.[2] in
+          if p2 = '-' then make_pred 1 set stp else
           (fun c -> if c == p1 || c == p2 || c == p3 then 1 else 0)
       | n -> make_pred 1 set stp
       end
@@ -679,6 +713,7 @@ let make_setp stp char_set =
           (fun c -> if c != p1 && c != p2 then 1 else 0)
       | 3 ->
           let p1 = set.[0] and p2 = set.[1] and p3 = set.[2] in
+          if p2 = '-' then make_pred 0 set stp else
           (fun c -> if c != p1 && c != p2 && c != p3 then 1 else 0)
       | n -> make_pred 0 set stp
       end;;
@@ -751,14 +786,14 @@ let scan_chars_in_char_set stp char_set max ib =
         | 0 -> loop (fun c -> 0) max
         | 1 -> loop_pos1 set.[0] max
         | 2 -> loop_pos2 set.[0] set.[1] max
-        | 3 -> loop_pos3 set.[0] set.[1] set.[2] max
+        | 3 when set.[1] != '-' -> loop_pos3 set.[0] set.[1] set.[2] max
         | n -> loop (find_setp stp char_set) max end
     | Neg_set set ->
         begin match String.length set with
         | 0 -> loop (fun c -> 1) max
         | 1 -> loop_neg1 set.[0] max
         | 2 -> loop_neg2 set.[0] set.[1] max
-        | 3 -> loop_neg3 set.[0] set.[1] set.[2] max
+        | 3 when set.[1] != '-' -> loop_neg3 set.[0] set.[1] set.[2] max
         | n -> loop (find_setp stp char_set) max end in
   if stp != [] then check_char_in stp ib;
   max;;
@@ -834,7 +869,7 @@ let kscanf ib ef fmt f =
           if conv = 'c' then scan_char max ib else scan_Char max ib in
         scan_fmt (stack f (token_char ib)) (i + 1)
     | 'd' | 'i' | 'o' | 'u' | 'x' | 'X' as conv ->
-        let x = scan_int conv max ib in
+        let x = scan_int_conv conv max ib in
         scan_fmt (stack f (token_int conv ib)) (i + 1)
     | 'f' | 'g' | 'G' | 'e' | 'E' ->
         let x = scan_float max ib in
@@ -862,7 +897,7 @@ let kscanf ib ef fmt f =
         if i > lim then scan_fmt (stack f (get_count t ib)) i else begin
         match fmt.[i] with
         | 'd' | 'i' | 'o' | 'u' | 'x' | 'X' as conv ->
-            let x = scan_int conv max ib in
+            let x = scan_int_conv conv max ib in
             begin match t with
             | 'l' -> scan_fmt (stack f (token_int32 conv ib)) (i + 1)
             | 'L' -> scan_fmt (stack f (token_int64 conv ib)) (i + 1)
diff --git a/stdlib/scanf.mli b/stdlib/scanf.mli
index 891bf1abf3..09753cdbc4 100644
--- a/stdlib/scanf.mli
+++ b/stdlib/scanf.mli
@@ -197,7 +197,6 @@ val bscanf :
 *)
 
 val fscanf : in_channel -> ('a, Scanning.scanbuf, 'b) format -> 'a -> 'b;;
-
 (** Same as {!Scanf.bscanf}, but inputs from the given channel.
 
     Warning: since all scanning functions operate from a scanning
@@ -221,7 +220,7 @@ val sscanf : string -> ('a, Scanning.scanbuf, 'b) format -> 'a -> 'b;;
 
 val scanf : ('a, Scanning.scanbuf, 'b) format -> 'a -> 'b;;
 (** Same as {!Scanf.bscanf}, but reads from the predefined scanning
-    buffer [Scanning.stdib] that is connected to [stdin]. *)
+    buffer {!Scanf.Scanning.stdib} that is connected to [stdin]. *)
 
 val kscanf :
   Scanning.scanbuf -> (Scanning.scanbuf -> exn -> 'a) ->
diff --git a/stdlib/set.ml b/stdlib/set.ml
index 2404c53854..e4ef7a0d94 100644
--- a/stdlib/set.ml
+++ b/stdlib/set.ml
@@ -48,6 +48,7 @@ module type S =
     val min_elt: t -> elt
     val max_elt: t -> elt
     val choose: t -> elt
+    val split: elt -> t -> t * bool * t
   end
 
 module Make(Ord: OrderedType) =
@@ -243,23 +244,26 @@ module Make(Ord: OrderedType) =
           | (l2, true, r2) ->
               concat (diff l1 l2) (diff r1 r2)
 
-    let rec compare_aux l1 l2 =
-        match (l1, l2) with
-        ([], []) -> 0
-      | ([], _)  -> -1
-      | (_, []) -> 1
-      | (Empty :: t1, Empty :: t2) ->
-          compare_aux t1 t2
-      | (Node(Empty, v1, r1, _) :: t1, Node(Empty, v2, r2, _) :: t2) ->
+    type enumeration = End | More of elt * t * enumeration
+
+    let rec cons_enum s e =
+      match s with
+        Empty -> e
+      | Node(l, v, r, _) -> cons_enum l (More(v, r, e))
+
+    let rec compare_aux e1 e2 =
+        match (e1, e2) with
+        (End, End) -> 0
+      | (End, _)  -> -1
+      | (_, End) -> 1
+      | (More(v1, r1, e1), More(v2, r2, e2)) ->
           let c = Ord.compare v1 v2 in
-          if c <> 0 then c else compare_aux (r1::t1) (r2::t2)
-      | (Node(l1, v1, r1, _) :: t1, t2) ->
-          compare_aux (l1 :: Node(Empty, v1, r1, 0) :: t1) t2
-      | (t1, Node(l2, v2, r2, _) :: t2) ->
-          compare_aux t1 (l2 :: Node(Empty, v2, r2, 0) :: t2)
+          if c <> 0
+          then c
+          else compare_aux (cons_enum r1 e1) (cons_enum r2 e2)
 
     let compare s1 s2 =
-      compare_aux [s1] [s2]
+      compare_aux (cons_enum s1 End) (cons_enum s2 End)
 
     let equal s1 s2 =
       compare s1 s2 = 0
diff --git a/stdlib/set.mli b/stdlib/set.mli
index fc4a1f4be6..69b0895f1e 100644
--- a/stdlib/set.mli
+++ b/stdlib/set.mli
@@ -136,6 +136,15 @@ module type S =
     (** Return one element of the given set, or raise [Not_found] if
        the set is empty. Which element is chosen is unspecified,
        but equal elements will be chosen for equal sets. *)
+
+    val split: elt -> t -> t * bool * t
+    (** [split x s] returns a triple [(l, present, r)], where
+          [l] is the set of elements of [s] that are
+          strictly less than [x];
+          [r] is the set of elements of [s] that are
+          strictly greater than [x];
+          [present] is [false] if [s] contains no element equal to [x],
+          or [true] if [s] contains an element equal to [x]. *)
   end
 (** Output signature of the functor {!Set.Make}. *)
 
diff --git a/stdlib/stdLabels.mli b/stdlib/stdLabels.mli
index 4750bbffbc..fbda4b7a49 100644
--- a/stdlib/stdLabels.mli
+++ b/stdlib/stdLabels.mli
@@ -50,6 +50,7 @@ module Array :
     val fold_right : f:('a -> 'b -> 'b) -> 'a array -> init:'b -> 'b
     val sort : cmp:('a -> 'a -> int) -> 'a array -> unit
     val stable_sort : cmp:('a -> 'a -> int) -> 'a array -> unit
+    val fast_sort : cmp:('a -> 'a -> int) -> 'a array -> unit
     external unsafe_get : 'a array -> int -> 'a = "%array_unsafe_get"
     external unsafe_set : 'a array -> int -> 'a -> unit = "%array_unsafe_set"
   end
@@ -97,6 +98,7 @@ module List :
     val combine : 'a list -> 'b list -> ('a * 'b) list
     val sort : cmp:('a -> 'a -> int) -> 'a list -> 'a list
     val stable_sort : cmp:('a -> 'a -> int) -> 'a list -> 'a list
+    val fast_sort : cmp:('a -> 'a -> int) -> 'a list -> 'a list
   end
 
 module String :
diff --git a/stdlib/sys.ml b/stdlib/sys.ml
index 99ecb18528..d1478525c6 100644
--- a/stdlib/sys.ml
+++ b/stdlib/sys.ml
@@ -78,4 +78,4 @@ let catch_break on =
 
 (* OCaml version string, must be in the format described in sys.mli. *)
 
-let ocaml_version = "3.07+14 (2004-02-03)";;
+let ocaml_version = "3.07+22 (2004-06-16)";;
diff --git a/stdlib/sys.mli b/stdlib/sys.mli
index 28cb6de0e3..9c829b1660 100644
--- a/stdlib/sys.mli
+++ b/stdlib/sys.mli
@@ -32,7 +32,9 @@ external remove : string -> unit = "caml_sys_remove"
 
 external rename : string -> string -> unit = "caml_sys_rename"
 (** Rename a file. The first argument is the old name and the
-   second is the new name. *)
+   second is the new name. If there is already another file
+   under the new name, [rename] may replace it, or raise an
+   exception, depending on your operating system. *)
 
 external getenv : string -> string = "caml_sys_getenv"
 (** Return the value associated to a variable in the process
@@ -98,9 +100,11 @@ type signal_behavior =
 
 external signal :
   int -> signal_behavior -> signal_behavior = "caml_install_signal_handler"
-(** Set the behavior of the system on receipt of a given signal.
-   The first argument is the signal number.  Return the behavior
-   previously associated with the signal. *)
+(** Set the behavior of the system on receipt of a given signal.  The
+   first argument is the signal number.  Return the behavior
+   previously associated with the signal. If the signal number is
+   invalid (or not available on your system), an [Invalid_argument]
+   exception is raised. *)
 
 val set_signal : int -> signal_behavior -> unit
 (** Same as {!Sys.signal} but return value is ignored. *)
diff --git a/test/Moretest/morematch.ml b/test/Moretest/morematch.ml
index b8f00b81f1..e6a0a1cb60 100644
--- a/test/Moretest/morematch.ml
+++ b/test/Moretest/morematch.ml
@@ -1105,3 +1105,33 @@ let _  =
   test "luc"  f (B, A, A, A, A, A, A, A, A, A, A, B, A, A, A, A) "10" ;
   test "luc"  f (B, A, A, A, A, A, A, A, A, A, A, A, A, A, A, A) "12" ;
  ()
+
+(*
+  By Gilles Peskine, compilation raised some assert false i make_failactionneg
+*)
+
+type bg = [
+  | `False
+  | `True
+  ]
+  
+type vg = [
+  | `A
+  | `B
+  | `U of int
+  | `V of int
+  ]
+
+type tg = {
+    v : vg;
+    x : bg;
+  }
+
+let predg x = true 
+
+let rec gilles o = match o with
+  | {v = (`U data | `V data); x = `False} when predg o -> 1
+  | {v = (`A|`B) ; x = `False}
+  | {v = (`U _ | `V _); x = `False}
+  | {v = _ ; x = `True}
+    -> 2
diff --git a/test/Moretest/tscanf.ml b/test/Moretest/tscanf.ml
index 38605fe5fc..0cb7658f75 100644
--- a/test/Moretest/tscanf.ml
+++ b/test/Moretest/tscanf.ml
@@ -789,6 +789,14 @@ let test42 () =
 
 test (test42 ());;
 
+let test50 () =
+ let s = "12.2" in
+ let ib = Scanning.from_string s in
+ bscanf ib "%[0-9].%[0-9]%s%!" (fun s1 s2 s3 ->
+   s1 = "12" && s2 = "2" && s3 = "");;
+
+test (test50 ());;
+
 (*******
 
 print_string "Test number is "; 
diff --git a/test/Results/fft.fast.runtest.Mac b/test/Results/fft.fast.runtest.Mac
deleted file mode 100644
index d54a175ac9..0000000000
--- a/test/Results/fft.fast.runtest.Mac
+++ /dev/null
@@ -1,12 +0,0 @@
-set echo 0
-
-if "{1}" == test
-  shift
-  set exit 0
-  {"parameters"} | search -r /e-[1-9][0-9]+�/
-  exit 0 if {status}
-  exit 2
-else if "{1}" == bench
-  shift
-  time {"parameters"} ">dev:null"
-end
diff --git a/test/Results/fft.runtest.Mac b/test/Results/fft.runtest.Mac
deleted file mode 100644
index d54a175ac9..0000000000
--- a/test/Results/fft.runtest.Mac
+++ /dev/null
@@ -1,12 +0,0 @@
-set echo 0
-
-if "{1}" == test
-  shift
-  set exit 0
-  {"parameters"} | search -r /e-[1-9][0-9]+�/
-  exit 0 if {status}
-  exit 2
-else if "{1}" == bench
-  shift
-  time {"parameters"} ">dev:null"
-end
diff --git a/test/Results/genlex.runtest.Mac b/test/Results/genlex.runtest.Mac
deleted file mode 100644
index 26a11620b2..0000000000
--- a/test/Results/genlex.runtest.Mac
+++ /dev/null
@@ -1,7 +0,0 @@
-if "{1}" == test
-  shift
-  {parameters} :Lex:testscanner.mll
-else if "{1}" == bench
-  shift
-  time {"parameters"} :Lex:testscanner.mll "�dev:null"
-end
diff --git a/test/testinterp/lib.ml b/test/testinterp/lib.ml
index 967d713c9e..557fc04ad2 100644
--- a/test/testinterp/lib.ml
+++ b/test/testinterp/lib.ml
@@ -1,3 +1,5 @@
+(* file $Id$ *)
+
 external raise : exn -> 'a = "%raise"
 
 external not : bool -> bool = "%boolnot"
@@ -35,8 +37,10 @@ external decr : int ref -> unit = "%decr"
 type 'a option = None | Some of 'a
 
 type 'a weak_t;;
-external weak_create: int -> 'a weak_t = "weak_create";;
-external weak_set : 'a weak_t -> int -> 'a option -> unit = "weak_set";;
-external weak_get: 'a weak_t -> int -> 'a option = "weak_get";;
+external weak_create: int -> 'a weak_t = "caml_weak_create";;
+external weak_set : 'a weak_t -> int -> 'a option -> unit = "caml_weak_set";;
+external weak_get: 'a weak_t -> int -> 'a option = "caml_weak_get";;
 
 let x = 42;;
+
+(* eof $Id$ *)
diff --git a/testlabl/poly.exp b/testlabl/poly.exp
index 8df92e4445..2b3faffa58 100644
--- a/testlabl/poly.exp
+++ b/testlabl/poly.exp
@@ -1,4 +1,4 @@
-        Objective Caml version 3.07+4 (2003-11-07)
+        Objective Caml version 3.07+19 (2004-05-26)
 
 #   * * *       #   type 'a t = { t : 'a; }
 # type 'a fold = { fold : 'b. f:('b -> 'a -> 'b) -> init:'b -> 'b; }
@@ -322,11 +322,29 @@ Warning: the following private methods were made public implicitly:
   n
 val f : unit -> < m : int; n : int > = <fun>
 # Characters 11-56:
-This object is expected to have type c = < m : int > but has actually type
+This object is expected to have type c but has actually type
   < m : int; n : 'a >
 Only the second object type has a method n
 # Characters 11-69:
 This object is expected to have type < n : int > but has actually type
   < m : 'a >
 Only the first object type has a method n
+#         Characters 66-124:
+This object is expected to have type < x : int; .. > but has actually type
+  < x : int >
+Self type cannot be unified with a closed object type
+#         val o : < x : int > = <obj>
+#         Characters 76-77:
+This expression has type < m : 'b. 'b * < m : 'b * 'a > > as 'a
+but is here used with type
+  < m : 'b. 'b * (< m : 'b * < m : 'd. 'd * 'c > > as 'c) >
+Types for method m are incompatible
+#         Characters 176-177:
+This expression has type foo' = < m : 'a. 'a * 'a foo >
+but is here used with type bar' = < m : 'a. 'a * 'a bar >
+Type 'a foo = < m : 'a * 'a foo > is not compatible with type
+  'a bar = < m : 'a * < m : 'b. 'b * 'a bar > > 
+Type 'a foo = < m : 'a * 'a foo > is not compatible with type
+  < m : 'b. 'b * 'a bar > 
+Types for method m are incompatible
 # 
diff --git a/testlabl/poly.exp2 b/testlabl/poly.exp2
index 4d5a15d311..dba450e7c5 100644
--- a/testlabl/poly.exp2
+++ b/testlabl/poly.exp2
@@ -1,4 +1,4 @@
-        Objective Caml version 3.07+4 (2003-11-07)
+        Objective Caml version 3.07+19 (2004-05-26)
 
 #   * * *       #   type 'a t = { t : 'a; }
 # type 'a fold = { fold : 'b. f:('b -> 'a -> 'b) -> init:'b -> 'b; }
@@ -329,11 +329,29 @@ Warning: the following private methods were made public implicitly:
   n
 val f : unit -> < m : int; n : int > = <fun>
 # Characters 11-56:
-This object is expected to have type c = < m : int > but has actually type
+This object is expected to have type c but has actually type
   < m : int; n : 'a >
 Only the second object type has a method n
 # Characters 11-69:
 This object is expected to have type < n : int > but has actually type
   < m : 'a >
 Only the first object type has a method n
+#         Characters 66-124:
+This object is expected to have type < x : int; .. > but has actually type
+  < x : int >
+Self type cannot be unified with a closed object type
+#         val o : < x : int > = <obj>
+#         Characters 76-77:
+This expression has type < m : 'b. 'b * < m : 'b * 'a > > as 'a
+but is here used with type
+  < m : 'b. 'b * (< m : 'b * < m : 'd. 'd * 'c > > as 'c) >
+Types for method m are incompatible
+#         Characters 176-177:
+This expression has type foo' = < m : 'a. 'a * 'a foo >
+but is here used with type bar' = < m : 'a. 'a * 'a bar >
+Type 'a foo = < m : 'a * 'a foo > is not compatible with type
+  'a bar = < m : 'a * < m : 'b. 'b * 'a bar > > 
+Type 'a foo = < m : 'a * 'a foo > is not compatible with type
+  < m : 'b. 'b * 'a bar > 
+Types for method m are incompatible
 # 
diff --git a/testlabl/poly.ml b/testlabl/poly.ml
index 3ce1f30e3a..7ee3fd9dbe 100644
--- a/testlabl/poly.ml
+++ b/testlabl/poly.ml
@@ -466,3 +466,23 @@ let f () = object (self:c) method private n = 1 method m = self#n end;;
 let f () = object method private n = 1 method m = {<>}#n end;;
 let f () = object (self:c) method n = 1 method m = 2 end;;
 let f () = object (_:'s) constraint 's = < n : int > method m = 1 end;;
+class c = object (_ : 's)
+  method x = 1
+  method private m =
+    object (self: 's) method x = 3 method private m = self end
+end;;
+let o = object (_ : 's)
+  method x = 1
+  method private m =
+    object (self: 's) method x = 3 method private m = self end
+end;;
+
+
+(* Unsound! *)
+fun (x : <m : 'a. 'a * <m: 'b. 'a * 'foo> > as 'foo) ->
+  (x : <m : 'a. 'a * (<m:'b. 'a * <m:'c. 'c * 'bar> > as 'bar) >);;
+type 'a foo = <m: 'b. 'a * 'a foo>
+type foo' =   <m: 'a. 'a * 'a foo>
+type 'a bar = <m: 'b. 'a * <m: 'c. 'c * 'a bar> >
+type bar' =   <m: 'a. 'a * 'a bar >
+let f (x : foo') = (x : bar');;
diff --git a/tools/Makefile b/tools/Makefile
index f9d3343514..8024944146 100644
--- a/tools/Makefile
+++ b/tools/Makefile
@@ -23,7 +23,7 @@ INCLUDES=-I ../utils -I ../parsing -I ../typing -I ../bytecomp -I ../asmcomp \
 COMPFLAGS= -warn-error A $(INCLUDES)
 LINKFLAGS=$(INCLUDES)
 
-all: ocamldep ocamlprof ocamlcp ocamlmktop ocamlmklib scrapelabels addlabels
+all: ocamldep ocamlprof ocamlcp ocamlmktop ocamlmklib scrapelabels addlabels 
 
 opt.opt: ocamldep.opt
 
@@ -97,6 +97,7 @@ clean::
 	rm -f ocamlmklib
 
 ocamlmklib.ml: ocamlmklib.mlp ../config/Makefile
+	echo '(* THIS FILE IS GENERATED FROM ocamlmklib.mlp *)' >ocamlmklib.ml
 	sed -e "s|%%BINDIR%%|$(BINDIR)|" \
             -e "s|%%SUPPORTS_SHARED_LIBRARIES%%|$(SUPPORTS_SHARED_LIBRARIES)|" \
             -e "s|%%MKSHAREDLIB%%|$(MKSHAREDLIB)|" \
@@ -104,7 +105,7 @@ ocamlmklib.ml: ocamlmklib.mlp ../config/Makefile
             -e "s|%%NATIVECCRPATH%%|$(NATIVECCRPATH)|" \
             -e "s|%%MKSHAREDLIBRPATH%%|$(MKSHAREDLIBRPATH)|" \
             -e "s|%%RANLIB%%|$(RANLIB)|" \
-          ocamlmklib.mlp > ocamlmklib.ml
+          ocamlmklib.mlp >> ocamlmklib.ml
 
 beforedepend:: ocamlmklib.ml
 
diff --git a/tools/dumpobj.ml b/tools/dumpobj.ml
index 4605b765ad..a362c91a10 100644
--- a/tools/dumpobj.ml
+++ b/tools/dumpobj.ml
@@ -234,6 +234,7 @@ type shape =
   | Uint_Primitive
   | Switch
   | Closurerec
+  | Pubmet
 ;;
 
 let op_shapes = [
@@ -368,6 +369,8 @@ let op_shapes = [
   opOFFSETREF, Sint;
   opISINT, Nothing;
   opGETMETHOD, Nothing;
+  opGETDYNMET, Nothing;
+  opGETPUBMET, Pubmet;
   opBEQ, Sint_Disp;
   opBNEQ, Sint_Disp;
   opBLTINT, Sint_Disp;
@@ -436,6 +439,10 @@ let print_instr ic =
           print_string ", ";
           print_int (orig + inputu ic);
         done;
+  | Pubmet
+     -> let tag = inputs ic in
+        let cache = inputu ic in
+	print_int tag
   | Nothing -> ()
   with Not_found -> print_string "(unknown arguments)"
   end;
@@ -522,13 +529,17 @@ let dump_exe ic =
 
 let main() =
   for i = 1 to Array.length Sys.argv - 1 do
-    let ic = open_in_bin Sys.argv.(i) in
+    let filnam = Sys.argv.(i) in
+    let ic = open_in_bin filnam in
+    if i>1 then print_newline ();
+    printf "## start of ocaml dump of %S\n%!" filnam;
     begin try
       objfile := false; dump_exe ic
     with Bytesections.Bad_magic_number ->
       objfile := true; seek_in ic 0; dump_obj (Sys.argv.(i)) ic
     end;
-    close_in ic
+    close_in ic;
+    printf "## end of ocaml dump of %S\n%!" filnam;
   done;
   exit 0
 
diff --git a/tools/make-opcodes.Mac b/tools/make-opcodes.Mac
deleted file mode 100644
index 0d13822973..0000000000
--- a/tools/make-opcodes.Mac
+++ /dev/null
@@ -1,14 +0,0 @@
-set echo 0
-exit 1 if {#} != 2
-
-catenate "{1}" >"{2}"
-open -t "{2}"
-replace �:/�  / 'let op' "{2}"
-set i 0
-loop
-  replace /,[ �n]+/ " = {i}�nlet op" "{2}" || break
-  evaluate i += 1
-end
-replace /�[� ]/:� " = {i}�n" "{2}"
-
-close -y "{2}"
diff --git a/tools/make-package-macosx b/tools/make-package-macosx
index 8f574d9c0c..557084cad8 100755
--- a/tools/make-package-macosx
+++ b/tools/make-package-macosx
@@ -15,21 +15,101 @@
 # $Id$
 
 cd package-macosx
-rm -rf ocaml.pkg ocaml-rw.dmg ocaml.dmg
-
-cat >ocaml.info <<EOF
-  Title Objective Caml
-  Version 3.06
-  Description This package installs Objective Caml version 3.06
-  DefaultLocation /
-  Relocatable no
-  NeedsAuthorization yes
-  Application no
-  InstallOnly no
-  DisableStop no
+rm -rf ocaml.pkg ocaml-rw.dmg
+
+VERSION=`sed -n -e '/ocaml_version/s/.*"\([^"]*\)".*/\1/p' ../stdlib/sys.ml`
+VERSION_MAJOR=`sed -n -e '/ocaml_version/s/.*"\([0-9]*\)\..*/\1/p' \
+                   ../stdlib/sys.ml`
+VERSION_MINOR=`sed -n -e '/ocaml_version/s/.*"[0-9]*\.\([0-9]*\)[.+].*/\1/p' \
+                   ../stdlib/sys.ml`
+
+# Worked in 10.2:
+
+# cat >ocaml.info <<EOF
+#   Title Objective Caml
+#   Version ${VERSION}
+#   Description This package installs Objective Caml version ${VERSION}
+#   DefaultLocation /
+#   Relocatable no
+#   NeedsAuthorization yes
+#   Application no
+#   InstallOnly no
+#   DisableStop no
+# EOF
+#package root ocaml.info
+
+cat >Description.plist <<EOF
+  <?xml version="1.0" encoding="UTF-8"?>
+  <!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN"
+            "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
+  <plist version="1.0">
+  <dict>
+          <key>IFPkgDescriptionDeleteWarning</key>
+          <string></string>
+          <key>IFPkgDescriptionDescription</key>
+          <string>The Objective Caml compiler and tools</string>
+          <key>IFPkgDescriptionTitle</key>
+          <string>Objective Caml</string>
+          <key>IFPkgDescriptionVersion</key>
+          <string>${VERSION}</string>
+  </dict>
+  </plist>
+EOF
+
+cat >Info.plist <<EOF
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN"
+          "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
+<plist version="1.0">
+<dict>
+        <key>CFBundleGetInfoString</key>
+        <string>Objective Caml ${VERSION}</string>
+        <key>CFBundleIdentifier</key>
+        <string>fr.inria.ocaml</string>
+        <key>CFBundleName</key>
+        <string>Objective Caml</string>
+        <key>CFBundleShortVersionString</key>
+        <string>${VERSION}</string>
+        <key>IFMajorVersion</key>
+        <integer>${VERSION_MAJOR}</integer>
+        <key>IFMinorVersion</key>
+        <integer>${VERSION_MINOR}</integer>
+        <key>IFPkgFlagAllowBackRev</key>
+        <true/>
+        <key>IFPkgFlagAuthorizationAction</key>
+        <string>AdminAuthorization</string>
+        <key>IFPkgFlagDefaultLocation</key>
+        <string>/</string>
+        <key>IFPkgFlagInstallFat</key>
+        <false/>
+        <key>IFPkgFlagIsRequired</key>
+        <false/>
+        <key>IFPkgFlagRelocatable</key>
+        <false/>
+        <key>IFPkgFlagRestartAction</key>
+        <string>NoRestart</string>
+        <key>IFPkgFlagRootVolumeOnly</key>
+        <true/>
+        <key>IFPkgFlagUpdateInstalledLanguages</key>
+        <false/>
+        <key>IFPkgFormatVersion</key>
+        <real>0.10000000149011612</real>
+</dict>
+</plist>
+EOF
+
+mkdir -p resources
+
+#                                         stop here -> |
+cat >resources/ReadMe.txt <<EOF
+This package installs Objective Caml version ${VERSION}.
+You need Mac OS X 10.3 (panther), with X11 and the
+XCode tools installed.
 EOF
 
-package root ocaml.info
+/Developer/Applications/Utilities/PackageMaker.app/Contents/MacOS/PackageMaker \
+  -build -p "`pwd`/ocaml.pkg" -f "`pwd`/root" -i "`pwd`/Info.plist" \
+  -d "`pwd`/Description.plist" -r "`pwd`/resources"
 
 size=`du -s ocaml.pkg | cut -f 1`
 size=`expr $size + 8192`
@@ -42,6 +122,7 @@ hdiutil detach $name
 name=`hdid ocaml-rw.dmg | grep Apple_HFS | cut -d ' ' -f 1`
 if test -d '/Volumes/Objective Caml'; then
   ditto -rsrcFork ocaml.pkg "/Volumes/Objective Caml/ocaml.pkg"
+  cp resources/ReadMe.txt "/Volumes/Objective Caml/"
 else
   echo 'Unable to mount the disk image as "/Volumes/Objective Caml"' >&2
   exit 3
@@ -49,4 +130,5 @@ fi
 open "/Volumes/Objective Caml"
 hdiutil detach $name
 
-hdiutil convert ocaml-rw.dmg -format UDZO -o ocaml.dmg
+rm -rf "ocaml-${VERSION}.dmg"
+hdiutil convert ocaml-rw.dmg -format UDZO -o "ocaml${VERSION}.dmg"
diff --git a/tools/ocamlmklib.mlp b/tools/ocamlmklib.mlp
index 27eecccbc3..a97ba47a52 100644
--- a/tools/ocamlmklib.mlp
+++ b/tools/ocamlmklib.mlp
@@ -184,13 +184,19 @@ let make_rpath_ccopt flag =
 let prefix_list pref l =
   List.map (fun s -> pref ^ s) l
 
+let prepostfix pre name post =
+  let base = Filename.basename name in
+  let dir = Filename.dirname name in
+  Filename.concat dir (pre ^ base ^ post)
+;;
+
 let build_libs () =
   if !c_objs <> [] then begin
     if !dynlink then begin
       let retcode = command
-        (sprintf "%s dll%s.so %s %s %s %s %s"
+        (sprintf "%s %s %s %s %s %s %s"
                     mksharedlib
-                    !output_c
+                    (prepostfix "dll" !output_c ".so")
                     (String.concat " " !c_objs)
                     (String.concat " " !c_opts)
                     (String.concat " " !ld_opts)
@@ -198,15 +204,15 @@ let build_libs () =
                     (String.concat " " !c_libs)) in
       if retcode <> 0 then if !failsafe then dynlink := false else exit 2
     end;
-    safe_remove ("lib" ^ !output_c ^ ".a");
+    safe_remove (prepostfix "lib" !output_c ".a");
     scommand
-      (sprintf "ar rc lib%s.a %s"
-                  !output_c
+      (sprintf "ar rc %s %s"
+                  (prepostfix "lib" !output_c ".a")
                   (String.concat " " !c_objs));
     scommand
-      (sprintf "%s lib%s.a"
+      (sprintf "%s %s"
                   ranlib
-                  !output_c)
+                  (prepostfix "lib" !output_c ".a"))
   end;
   if !bytecode_objs <> [] then
     scommand
diff --git a/tools/ocamlprof.ml b/tools/ocamlprof.ml
index abc61ce39f..10c3c57459 100644
--- a/tools/ocamlprof.ml
+++ b/tools/ocamlprof.ml
@@ -21,8 +21,9 @@ open Location
 open Misc
 open Parsetree
 
-(* User programs must not use identifiers that start with this prefix. *)
-let idprefix = "__ocaml_prof";;
+(* User programs must not use identifiers that start with these prefixes. *)
+let idprefix = "__ocaml_prof_";;
+let modprefix = "OCAML__prof_";;
 
 
 (* Errors specific to the profiler *)
@@ -87,8 +88,10 @@ let add_incr_counter modul (kind,pos) =
    | Close -> fprintf !outchan ")";
    | Open ->
          fprintf !outchan
-                 "(%s_cnt_%s_.(%d) <- Pervasives.succ %s_cnt_%s_.(%d); "
-                 idprefix modul !prof_counter idprefix modul !prof_counter;
+                 "(%sArray.set %s_cnt %d \
+                               (%sPervasives.succ (%sArray.get %s_cnt %d)); "
+                 modprefix idprefix !prof_counter
+                 modprefix modprefix idprefix !prof_counter;
          incr prof_counter;
 ;;
 
@@ -127,12 +130,14 @@ let pos_len = ref 0
 let init_rewrite modes mod_name =
   cur_point := 0;
   if !instr_mode then begin
-    fprintf !outchan "let %s_cnt_%s_ = Array.create 0000000" idprefix mod_name;
+    fprintf !outchan "module %sArray = Array;; " modprefix;
+    fprintf !outchan "module %sPervasives = Pervasives;; " modprefix;
+    fprintf !outchan "let %s_cnt = Array.create 0000000" idprefix;
     pos_len := pos_out !outchan;
     fprintf !outchan 
             " 0;; Profiling.counters := \
-              (\"%s\", (\"%s\", %s_cnt_%s_)) :: !Profiling.counters;; "
-            mod_name modes idprefix mod_name
+              (\"%s\", (\"%s\", %s_cnt)) :: !Profiling.counters;; "
+            mod_name modes idprefix;
   end
 
 let final_rewrite add_function =
@@ -178,7 +183,7 @@ and rw_exp iflag sexp =
     rewrite_exp iflag sbody
 
   | Pexp_function (_, _, caselist) ->
-    if !instr_fun && not sexp.pexp_loc.loc_ghost then
+    if !instr_fun then
       rewrite_function iflag caselist
     else
       rewrite_patlexp_list iflag caselist
@@ -414,6 +419,7 @@ let process_intf_file filename = null_rewrite filename;;
 
 let process_impl_file filename =
    let modname = Filename.basename(Filename.chop_extension filename) in
+       (* FIXME should let modname = String.capitalize modname *)
    if !instr_mode then begin
      (* Instrumentation mode *)
      set_flags !modes;
diff --git a/toplevel/genprintval.ml b/toplevel/genprintval.ml
index cea42aa907..7094a453cb 100644
--- a/toplevel/genprintval.ml
+++ b/toplevel/genprintval.ml
@@ -367,9 +367,9 @@ module Make(O : OBJ)(EVP : EVALPATH with type value = O.t) = struct
         tree_of_constr_with_args
            (fun x -> Oide_ident x) name 1 depth bucket cstr.cstr_args
       with Not_found | EVP.Error ->
-        match check_depth depth obj ty with
+        match check_depth depth bucket ty with
           Some x -> x
-        | None -> outval_of_untyped_exception obj
+        | None -> outval_of_untyped_exception bucket
 
     in tree_of_val max_depth obj ty
 
diff --git a/toplevel/topdirs.ml b/toplevel/topdirs.ml
index 18498772a6..2c951cc7f1 100644
--- a/toplevel/topdirs.ml
+++ b/toplevel/topdirs.ml
@@ -249,7 +249,7 @@ let dir_untrace ppf lid =
         []
     | f :: rem ->
         if Path.same f.path path then begin
-          set_code_pointer (eval_path path) f.actual_code;
+          set_code_pointer f.closure f.actual_code;
           fprintf ppf "%a is no longer traced.@." Printtyp.longident lid;
           rem
         end else f :: remove rem in
@@ -260,7 +260,7 @@ let dir_untrace ppf lid =
 let dir_untrace_all ppf () =
   List.iter
     (fun f ->
-      set_code_pointer (eval_path f.path) f.actual_code;
+      set_code_pointer f.closure f.actual_code;
       fprintf ppf "%a is no longer traced.@." Printtyp.path f.path)
     !traced_functions;
   traced_functions := []
diff --git a/toplevel/toploop.ml b/toplevel/toploop.ml
index e1229990a6..ae319c42e0 100644
--- a/toplevel/toploop.ml
+++ b/toplevel/toploop.ml
@@ -132,11 +132,17 @@ let load_lambda ppf lam =
     may_trace := true;
     let retval = (Meta.reify_bytecode code code_size) () in
     may_trace := false;
-    if can_free then Meta.static_free code;
+    if can_free then begin 
+      Meta.static_release_bytecode code code_size;
+      Meta.static_free code;
+    end;
     Result retval
   with x ->
     may_trace := false;
-    if can_free then Meta.static_free code;
+    if can_free then begin 
+      Meta.static_release_bytecode code code_size;
+      Meta.static_free code;
+    end;
     Symtable.restore_state initial_symtable;
     Exception x
 
@@ -156,23 +162,23 @@ let pr_item env = function
             Some v
       in
       Some (tree, valopt, rem)
-  | Tsig_type(id, decl) :: rem ->
-      let tree = Printtyp.tree_of_type_declaration id decl in
+  | Tsig_type(id, decl, rs) :: rem ->
+      let tree = Printtyp.tree_of_type_declaration id decl rs in
       Some (tree, None, rem)
   | Tsig_exception(id, decl) :: rem ->
       let tree = Printtyp.tree_of_exception_declaration id decl in
       Some (tree, None, rem)
-  | Tsig_module(id, mty) :: rem ->
-      let tree = Printtyp.tree_of_module id mty in
+  | Tsig_module(id, mty, rs) :: rem ->
+      let tree = Printtyp.tree_of_module id mty rs in
       Some (tree, None, rem)
   | Tsig_modtype(id, decl) :: rem ->
       let tree = Printtyp.tree_of_modtype_declaration id decl in
       Some (tree, None, rem)
-  | Tsig_class(id, decl) :: cltydecl :: tydecl1 :: tydecl2 :: rem ->
-      let tree = Printtyp.tree_of_class_declaration id decl in
+  | Tsig_class(id, decl, rs) :: cltydecl :: tydecl1 :: tydecl2 :: rem ->
+      let tree = Printtyp.tree_of_class_declaration id decl rs in
       Some (tree, None, rem)
-  | Tsig_cltype(id, decl) :: tydecl1 :: tydecl2 :: rem ->
-      let tree = Printtyp.tree_of_cltype_declaration id decl in
+  | Tsig_cltype(id, decl, rs) :: tydecl1 :: tydecl2 :: rem ->
+      let tree = Printtyp.tree_of_cltype_declaration id decl rs in
       Some (tree, None, rem)
   | _ -> None
 
@@ -312,6 +318,26 @@ let use_silently ppf name =
 let first_line = ref true
 let got_eof = ref false;;
 
+let read_input_default prompt buffer len =
+  output_string stdout prompt; flush stdout;
+  let i = ref 0 in
+  try
+    while true do
+      if !i >= len then raise Exit;
+      let c = input_char stdin in
+      buffer.[!i] <- c;
+      incr i;
+      if c = '\n' then raise Exit;
+    done;
+    (!i, false)
+  with
+  | End_of_file ->
+      (!i, true)
+  | Exit ->
+      (!i, false)
+
+let read_interactive_input = ref read_input_default
+
 let refill_lexbuf buffer len =
   if !got_eof then (got_eof := false; 0) else begin
     let prompt =
@@ -319,23 +345,14 @@ let refill_lexbuf buffer len =
       else if Lexer.in_comment () then "* "
       else "  "
     in
-    output_string stdout prompt; flush stdout;
     first_line := false;
-    let i = ref 0 in
-    try
-      while true do
-        if !i >= len then raise Exit;
-        let c = input_char stdin in
-        buffer.[!i] <- c;
-        incr i;
-        if c = '\n' then raise Exit;
-      done;
-      !i
-    with
-    | End_of_file ->
-        Location.echo_eof ();
-        if !i > 0 then (got_eof := true; !i) else 0
-    | Exit -> !i
+    let (len, eof) = !read_interactive_input prompt buffer len in
+    if eof then begin
+      Location.echo_eof ();
+      if len > 0 then got_eof := true;
+      len
+    end else
+      len
   end
 
 (* Toplevel initialization. Performed here instead of at the
@@ -374,7 +391,7 @@ let initialize_toplevel_env () =
 exception PPerror
 
 let loop ppf =
-  fprintf ppf "        Objective Caml version %s@.@." Config.version;
+  fprintf ppf "        G'Caml version %s@.@." Config.version;
   initialize_toplevel_env ();
   let lb = Lexing.from_function refill_lexbuf in
   Location.input_name := "";
diff --git a/toplevel/toploop.mli b/toplevel/toploop.mli
index 18372c6bda..6b25941c83 100644
--- a/toplevel/toploop.mli
+++ b/toplevel/toploop.mli
@@ -98,6 +98,10 @@ val print_out_signature :
 val print_out_phrase :
   (formatter -> Outcometree.out_phrase -> unit) ref
 
+(* Hooks for external line editor *)
+
+val read_interactive_input : (string -> string -> int -> int * bool) ref
+
 (* Hooks for initialization *)
 
 val toplevel_startup_hook : (unit -> unit) ref
diff --git a/typing/ctype.ml b/typing/ctype.ml
index bc430b3771..da37d93184 100644
--- a/typing/ctype.ml
+++ b/typing/ctype.ml
@@ -825,7 +825,9 @@ let instance_class params cty =
           {cty_self = copy sign.cty_self;
            cty_vars =
              Vars.map (function (mut, ty) -> (mut, copy ty)) sign.cty_vars;
-           cty_concr = sign.cty_concr}
+           cty_concr = sign.cty_concr;
+           cty_inher =
+             List.map (fun (p,tl) -> (p, List.map copy tl)) sign.cty_inher}
     | Tcty_fun (l, ty, cty) ->
         Tcty_fun (l, copy ty, copy_class_type cty)
   in
@@ -1227,21 +1229,21 @@ let occur env ty0 ty =
    be done at meta-level, using bindings in univar_pairs *)
 let rec unify_univar t1 t2 = function
     (cl1, cl2) :: rem ->
-      let repr_univ = List.map (fun (t,o) -> repr t, o) in
-      let cl1 = repr_univ cl1 and cl2 = repr_univ cl2 in
-      begin try
-        let r1 = List.assq t1 cl1 in
-        match !r1 with
-          Some t -> if t2 != repr t then raise (Unify [])
-        | None ->
-            try
-              let r2 = List.assq t2 cl2 in
-              if !r2 <> None then raise (Unify []);
-              set_univar r1 t2; set_univar r2 t1
-            with Not_found ->
-              raise (Unify [])
-      with Not_found ->
-        unify_univar t1 t2 rem
+      let find_univ t cl =
+        try
+          let (_, r) = List.find (fun (t',_) -> t == repr t') cl in
+          Some r
+        with Not_found -> None
+      in
+      begin match find_univ t1 cl1, find_univ t2 cl2 with
+        Some {contents=Some t'2}, Some _ when t2 == repr t'2 ->
+          ()
+      | Some({contents=None} as r1), Some({contents=None} as r2) ->
+          set_univar r1 t2; set_univar r2 t1
+      | None, None ->
+          unify_univar t1 t2 rem
+      | _ ->
+          raise (Unify [])
       end
   | [] -> raise (Unify [])
 
@@ -1303,6 +1305,13 @@ let expand_trace env trace =
        (repr t1, full_expand env t1)::(repr t2, full_expand env t2)::rem)
     trace []
 
+(* build a dummy variant type *)
+let mkvariant fields closed =
+  newgenty
+    (Tvariant
+       {row_fields = fields; row_closed = closed; row_more = newvar();
+        row_bound = []; row_fixed = false; row_name = None })
+
 (**** Unification ****)
 
 (* Return whether [t0] occurs in [ty]. Objects are also traversed. *)
@@ -1460,9 +1469,9 @@ and unify3 env t1 t1' t2 t2' =
         unify_row env row1 row2
     | (Tfield _, Tfield _) ->           (* Actually unused *)
         unify_fields env t1' t2'
-    | (Tfield(_,kind,_,rem), Tnil) | (Tnil, Tfield(_,kind,_,rem)) ->
+    | (Tfield(f,kind,_,rem), Tnil) | (Tnil, Tfield(f,kind,_,rem)) ->
         begin match field_kind_repr kind with
-          Fvar r -> r := Some Fabsent
+          Fvar r when f <> dummy_method -> set_kind r Fabsent
         | _      -> raise (Unify [])
         end
     | (Tnil, Tnil) ->
@@ -1544,15 +1553,16 @@ and unify_fields env ty1 ty2 =          (* Optimization *)
   let (fields1, rest1) = flatten_fields ty1
   and (fields2, rest2) = flatten_fields ty2 in
   let (pairs, miss1, miss2) = associate_fields fields1 fields2 in
+  let l1 = (repr ty1).level and l2 = (repr ty2).level in
   let va =
     if miss1 = [] then rest2
     else if miss2 = [] then rest1
-    else newvar ()
+    else newty2 (min l1 l2) Tvar
   in
   let d1 = rest1.desc and d2 = rest2.desc in
   try
-    unify env (build_fields (repr ty1).level miss1 va) rest2;
-    unify env rest1 (build_fields (repr ty2).level miss2 va);
+    unify env (build_fields l1 miss1 va) rest2;
+    unify env rest1 (build_fields l2 miss2 va);
     List.iter
       (fun (n, k1, t1, k2, t2) ->
         unify_kind k1 k2;
@@ -1604,11 +1614,6 @@ and unify_row env row1 row2 =
         row_field_repr f1 = Rabsent || row_field_repr f2 <> Rabsent)
       pairs
   in
-  let mkvariant fields closed =
-    newgenty
-      (Tvariant
-         {row_fields = fields; row_closed = closed; row_more = newvar();
-          row_bound = []; row_fixed = false; row_name = None }) in
   let empty fields =
     List.for_all (fun (_,f) -> row_field_repr f = Rabsent) fields in
   (* Check whether we are going to build an empty type *)
@@ -1657,7 +1662,10 @@ and unify_row env row1 row2 =
     let undo = ref [] in
     List.iter
       (fun (l,f1,f2) ->
-        unify_row_field env row1.row_fixed row2.row_fixed undo l f1 f2)
+        try unify_row_field env row1.row_fixed row2.row_fixed undo l f1 f2
+        with Unify trace ->
+          raise (Unify ((mkvariant [l,f1] true,
+                         mkvariant [l,f2] true) :: trace)))
       pairs;
     (* Special case when there is only one field left *)
     if row0.row_closed then begin
@@ -1728,6 +1736,7 @@ and unify_row_field env fixed1 fixed2 undo l f1 f2 =
   | Rpresent None, Reither(true, [], _, e2) when not fixed2 ->
       set_row_field e2 f1
   | _ -> raise (Unify [])
+    
 
 let unify env ty1 ty2 =
   try
@@ -3191,7 +3200,10 @@ let nondep_class_signature env id sign =
     cty_vars =
       Vars.map (function (m, t) -> (m, nondep_type_rec env id t))
         sign.cty_vars;
-    cty_concr = sign.cty_concr }
+    cty_concr = sign.cty_concr;
+    cty_inher =
+      List.map (fun (p,tl) -> (p, List.map (nondep_type_rec env id) tl))
+        sign.cty_inher }
 
 let rec nondep_class_type env id =
   function
diff --git a/typing/env.ml b/typing/env.ml
index 85379b041b..b71c6bb581 100644
--- a/typing/env.ml
+++ b/typing/env.ml
@@ -420,7 +420,7 @@ let rec prefix_idents root pos sub = function
       let nextpos = match decl.val_kind with Val_prim _ -> pos | _ -> pos+1 in
       let (pl, final_sub) = prefix_idents root nextpos sub rem in
       (p::pl, final_sub)
-  | Tsig_type(id, decl) :: rem ->
+  | Tsig_type(id, decl, _) :: rem ->
       (* types bind their own values *)
       let p = Pdot(root, Ident.name id, pos) in
       let (pl, final_sub) =
@@ -430,7 +430,7 @@ let rec prefix_idents root pos sub = function
       let p = Pdot(root, Ident.name id, pos) in
       let (pl, final_sub) = prefix_idents root (pos+1) sub rem in
       (p::pl, final_sub)
-  | Tsig_module(id, mty) :: rem ->
+  | Tsig_module(id, mty, _) :: rem ->
       let p = Pdot(root, Ident.name id, pos) in
       let (pl, final_sub) =
         prefix_idents root (pos+1) (Subst.add_module id p sub) rem in
@@ -441,11 +441,11 @@ let rec prefix_idents root pos sub = function
         prefix_idents root pos
                       (Subst.add_modtype id (Tmty_ident p) sub) rem in
       (p::pl, final_sub)
-  | Tsig_class(id, decl) :: rem ->
+  | Tsig_class(id, decl, _) :: rem ->
       let p = Pdot(root, Ident.name id, pos) in
       let (pl, final_sub) = prefix_idents root (pos + 1) sub rem in
       (p::pl, final_sub)
-  | Tsig_cltype(id, decl) :: rem ->
+  | Tsig_cltype(id, decl, _) :: rem ->
       let p = Pdot(root, Ident.name id, nopos) in
       let (pl, final_sub) = prefix_idents root pos sub rem in
       (p::pl, final_sub)
@@ -473,7 +473,7 @@ let rec components_of_module env sub path mty =
             begin match decl.val_kind with
               Val_prim _ -> () | _ -> incr pos
             end
-        | Tsig_type(id, decl) ->
+        | Tsig_type(id, decl, _) ->
             let decl' = Subst.type_declaration sub decl in
             c.comp_types <-
               Tbl.add (Ident.name id) (decl', !pos) c.comp_types;
@@ -493,7 +493,7 @@ let rec components_of_module env sub path mty =
             c.comp_constrs <-
               Tbl.add (Ident.name id) (cstr, !pos) c.comp_constrs;
             incr pos
-        | Tsig_module(id, mty) ->
+        | Tsig_module(id, mty, _) ->
             let mty' = Subst.modtype sub mty in
             c.comp_modules <-
               Tbl.add (Ident.name id) (mty', !pos) c.comp_modules;
@@ -507,12 +507,12 @@ let rec components_of_module env sub path mty =
             c.comp_modtypes <-
               Tbl.add (Ident.name id) (decl', nopos) c.comp_modtypes;
             env := store_modtype id path decl !env
-        | Tsig_class(id, decl) ->
+        | Tsig_class(id, decl, _) ->
             let decl' = Subst.class_declaration sub decl in
             c.comp_classes <-
               Tbl.add (Ident.name id) (decl', !pos) c.comp_classes;
             incr pos
-        | Tsig_cltype(id, decl) ->
+        | Tsig_cltype(id, decl, _) ->
             let decl' = Subst.cltype_declaration sub decl in
             c.comp_cltypes <-
               Tbl.add (Ident.name id) (decl', !pos) c.comp_cltypes)
@@ -654,12 +654,12 @@ and enter_cltype = enter store_cltype
 let add_item comp env =
   match comp with
     Tsig_value(id, decl)     -> add_value id decl env
-  | Tsig_type(id, decl)      -> add_type id decl env
+  | Tsig_type(id, decl, _)   -> add_type id decl env
   | Tsig_exception(id, decl) -> add_exception id decl env
-  | Tsig_module(id, mty)     -> add_module id mty env
+  | Tsig_module(id, mty, _)  -> add_module id mty env
   | Tsig_modtype(id, decl)   -> add_modtype id decl env
-  | Tsig_class(id, decl)     -> add_class id decl env
-  | Tsig_cltype(id, decl)    -> add_cltype id decl env
+  | Tsig_class(id, decl, _)  -> add_class id decl env
+  | Tsig_cltype(id, decl, _) -> add_cltype id decl env
 
 let rec add_signature sg env =
   match sg with
@@ -679,21 +679,21 @@ let open_signature root sg env =
           Tsig_value(id, decl) ->
             store_value (Ident.hide id) p
                         (Subst.value_description sub decl) env
-        | Tsig_type(id, decl) ->
+        | Tsig_type(id, decl, _) ->
             store_type (Ident.hide id) p
                        (Subst.type_declaration sub decl) env
         | Tsig_exception(id, decl) ->
             store_exception (Ident.hide id) p
                             (Subst.exception_declaration sub decl) env
-        | Tsig_module(id, mty) ->
+        | Tsig_module(id, mty, _) ->
             store_module (Ident.hide id) p (Subst.modtype sub mty) env
         | Tsig_modtype(id, decl) ->
             store_modtype (Ident.hide id) p
                           (Subst.modtype_declaration sub decl) env
-        | Tsig_class(id, decl) ->
+        | Tsig_class(id, decl, _) ->
             store_class (Ident.hide id) p
                         (Subst.class_declaration sub decl) env
-        | Tsig_cltype(id, decl) ->
+        | Tsig_cltype(id, decl, _) ->
             store_cltype (Ident.hide id) p
                          (Subst.cltype_declaration sub decl) env)
       env sg pl in
diff --git a/typing/includemod.ml b/typing/includemod.ml
index ab035ece8d..8cf6d5ee8b 100644
--- a/typing/includemod.ml
+++ b/typing/includemod.ml
@@ -104,26 +104,24 @@ type field_desc =
 
 let item_ident_name = function
     Tsig_value(id, _) -> (id, Field_value(Ident.name id))
-  | Tsig_type(id, _) -> (id, Field_type(Ident.name id))
+  | Tsig_type(id, _, _) -> (id, Field_type(Ident.name id))
   | Tsig_exception(id, _) -> (id, Field_exception(Ident.name id))
-  | Tsig_module(id, _) -> (id, Field_module(Ident.name id))
+  | Tsig_module(id, _, _) -> (id, Field_module(Ident.name id))
   | Tsig_modtype(id, _) -> (id, Field_modtype(Ident.name id))
-  | Tsig_class(id, _) -> (id, Field_class(Ident.name id))
-  | Tsig_cltype(id, _) -> (id, Field_classtype(Ident.name id))
+  | Tsig_class(id, _, _) -> (id, Field_class(Ident.name id))
+  | Tsig_cltype(id, _, _) -> (id, Field_classtype(Ident.name id))
 
 (* Simplify a structure coercion *)
 
-let simplify_structure_coercion cc =
-  let pos = ref 0 in
-  try
-    List.iter
-      (fun (n, c) ->
-        if n <> !pos || c <> Tcoerce_none then raise Exit;
-        incr pos)
-      cc;
-    Tcoerce_none
-  with Exit ->
-    Tcoerce_structure cc
+let simplify_structure_coercion init_size cc =
+  let rec is_identity_coercion pos = function
+  | [] ->
+      pos = init_size
+  | (n, c) :: rem ->
+      n = pos && c = Tcoerce_none && is_identity_coercion (pos + 1) rem in
+  if is_identity_coercion 0 cc
+  then Tcoerce_none
+  else Tcoerce_structure cc
 
 (* Inclusion between module types. 
    Return the restriction that transforms a value of the smaller type
@@ -178,22 +176,22 @@ and signatures env subst sig1 sig2 =
   (* Build a table of the components of sig1, along with their positions.
      The table is indexed by kind and name of component *)
   let rec build_component_table pos tbl = function
-      [] -> tbl
+      [] -> (tbl, pos)
     | item :: rem ->
         let (id, name) = item_ident_name item in
         let nextpos =
           match item with
             Tsig_value(_,{val_kind = Val_prim _})
           | Tsig_modtype(_,_)
-          | Tsig_cltype(_,_) -> pos
+          | Tsig_cltype(_,_,_) -> pos
           | Tsig_value(_,_)
-          | Tsig_type(_,_)
+          | Tsig_type(_,_,_)
           | Tsig_exception(_,_)
-          | Tsig_module(_,_)
-          | Tsig_class(_, _) -> pos+1 in
+          | Tsig_module(_,_,_)
+          | Tsig_class(_, _,_) -> pos+1 in
         build_component_table nextpos
                               (Tbl.add name (id, item, pos) tbl) rem in
-  let comps1 =
+  let (comps1, size1) =
     build_component_table 0 Tbl.empty sig1 in
   (* Pair each component of sig2 with a component of sig1,
      identifying the names along the way.
@@ -227,7 +225,7 @@ and signatures env subst sig1 sig2 =
           pair_components subst paired (Missing_field id2 :: unpaired) rem
         end in
   (* Do the pairing and checking, and return the final coercion *)
-  simplify_structure_coercion(pair_components subst [] [] sig2)
+  simplify_structure_coercion size1 (pair_components subst [] [] sig2)
 
 (* Inclusion between signature components *)
 
@@ -239,24 +237,24 @@ and signature_components env subst = function
         Val_prim p -> signature_components env subst rem
       | _ -> (pos, cc) :: signature_components env subst rem
       end
-  | (Tsig_type(id1, tydecl1), Tsig_type(id2, tydecl2), pos) :: rem ->
+  | (Tsig_type(id1, tydecl1, _), Tsig_type(id2, tydecl2, _), pos) :: rem ->
       type_declarations env subst id1 tydecl1 tydecl2;
       (pos, Tcoerce_none) :: signature_components env 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
-  | (Tsig_module(id1, mty1), Tsig_module(id2, mty2), pos) :: 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
   | (Tsig_modtype(id1, info1), Tsig_modtype(id2, info2), pos) :: rem ->
       modtype_infos env subst id1 info1 info2;
       signature_components env subst rem
-  | (Tsig_class(id1, decl1), Tsig_class(id2, decl2), pos) :: 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
-  | (Tsig_cltype(id1, info1), Tsig_cltype(id2, info2), pos) :: rem ->
+  | (Tsig_cltype(id1, info1, _), Tsig_cltype(id2, info2, _), pos) :: rem ->
       class_type_declarations env subst id1 info1 info2;
       signature_components env subst rem
   | _ ->
diff --git a/typing/mtype.ml b/typing/mtype.ml
index 46c0348a25..b18c0a11c9 100644
--- a/typing/mtype.ml
+++ b/typing/mtype.ml
@@ -45,7 +45,7 @@ and strengthen_sig env sg p =
     [] -> []
   | (Tsig_value(id, desc) as sigelt) :: rem ->
       sigelt :: strengthen_sig env rem p
-  | Tsig_type(id, decl) :: rem ->
+  | Tsig_type(id, decl, rs) :: rem ->
       let newdecl =
         match decl.type_manifest with
           None ->
@@ -53,12 +53,12 @@ and strengthen_sig env sg p =
                 Some(Btype.newgenty(Tconstr(Pdot(p, Ident.name id, nopos),
                                             decl.type_params, ref Mnil))) }
         | _ -> decl in
-      Tsig_type(id, newdecl) :: strengthen_sig env rem p
+      Tsig_type(id, newdecl, rs) :: strengthen_sig env rem p
   | (Tsig_exception(id, d) as sigelt) :: rem ->
       sigelt :: strengthen_sig env rem p
-  | Tsig_module(id, mty) :: rem ->
-      Tsig_module(id, strengthen env mty (Pdot(p, Ident.name id, nopos))) ::
-      strengthen_sig (Env.add_module id mty env) rem p
+  | Tsig_module(id, mty, rs) :: rem ->
+      Tsig_module(id, strengthen env mty (Pdot(p, Ident.name id, nopos)), rs)
+      :: strengthen_sig (Env.add_module id mty env) rem p
       (* Need to add the module in case it defines manifest module types *)
   | Tsig_modtype(id, decl) :: rem ->
       let newdecl =
@@ -70,9 +70,9 @@ and strengthen_sig env sg p =
       Tsig_modtype(id, newdecl) ::
       strengthen_sig (Env.add_modtype id decl env) rem p
       (* Need to add the module type in case it is manifest *)
-  | (Tsig_class(id, decl) as sigelt) :: rem ->
+  | (Tsig_class(id, decl, rs) as sigelt) :: rem ->
       sigelt :: strengthen_sig env rem p
-  | (Tsig_cltype(id, decl) as sigelt) :: rem ->
+  | (Tsig_cltype(id, decl, rs) as sigelt) :: rem ->
       sigelt :: strengthen_sig env rem p
 
 (* In nondep_supertype, env is only used for the type it assigns to id.
@@ -102,16 +102,15 @@ let nondep_supertype env mid mty =
       let rem' = nondep_sig va rem in
       match item with
         Tsig_value(id, d) ->
-	  let t = Ctype.nondep_type env mid d.val_type in
-          Tsig_value(id, {val_type = t;
-                          val_kind = d.val_kind }) ::
-	  rem'
-      | Tsig_type(id, d) ->
-          Tsig_type(id, Ctype.nondep_type_decl env mid id (va = Co) d) :: rem'
+          Tsig_value(id, {val_type = Ctype.nondep_type env mid d.val_type;
+                          val_kind = d.val_kind}) :: rem'
+      | Tsig_type(id, d, rs) ->
+          Tsig_type(id, Ctype.nondep_type_decl env mid id (va = Co) d, rs)
+          :: rem'
       | Tsig_exception(id, d) ->
           Tsig_exception(id, List.map (Ctype.nondep_type env mid) d) :: rem'
-      | Tsig_module(id, mty) ->
-          Tsig_module(id, nondep_mty va mty) :: rem'
+      | Tsig_module(id, mty, rs) ->
+          Tsig_module(id, nondep_mty va mty, rs) :: rem'
       | Tsig_modtype(id, d) ->
           begin try
             Tsig_modtype(id, nondep_modtype_decl d) :: rem'
@@ -120,10 +119,12 @@ let nondep_supertype env mid mty =
               Co -> Tsig_modtype(id, Tmodtype_abstract) :: rem'
             | _  -> raise Not_found
           end
-      | Tsig_class(id, d) ->
-          Tsig_class(id, Ctype.nondep_class_declaration env mid d) :: rem'
-      | Tsig_cltype(id, d) ->
-          Tsig_cltype(id, Ctype.nondep_cltype_declaration env mid d) :: rem'
+      | Tsig_class(id, d, rs) ->
+          Tsig_class(id, Ctype.nondep_class_declaration env mid d, rs)
+          :: rem'
+      | Tsig_cltype(id, d, rs) ->
+          Tsig_cltype(id, Ctype.nondep_cltype_declaration env mid d, rs)
+          :: rem'
 
   and nondep_modtype_decl = function
       Tmodtype_abstract -> Tmodtype_abstract
@@ -153,10 +154,12 @@ let rec enrich_modtype env p mty =
       mty
 
 and enrich_item env p = function
-    Tsig_type(id, decl) ->
-      Tsig_type(id, enrich_typedecl env (Pdot(p, Ident.name id, nopos)) decl)
-  | Tsig_module(id, mty) ->
-      Tsig_module(id, enrich_modtype env (Pdot(p, Ident.name id, nopos)) mty)
+    Tsig_type(id, decl, rs) ->
+      Tsig_type(id,
+                enrich_typedecl env (Pdot(p, Ident.name id, nopos)) decl, rs)
+  | Tsig_module(id, mty, rs) ->
+      Tsig_module(id,
+                  enrich_modtype env (Pdot(p, Ident.name id, nopos)) mty, rs)
   | item -> item
 
 let rec type_paths env p mty =
@@ -171,10 +174,10 @@ and type_paths_sig env p pos sg =
   | Tsig_value(id, decl) :: rem ->
       let pos' = match decl.val_kind with Val_prim _ -> pos | _ -> pos + 1 in
       type_paths_sig env p pos' rem
-  | Tsig_type(id, decl) :: rem ->
+  | Tsig_type(id, decl, _) :: rem ->
       let pos' = pos + 1 in
       Pdot(p, Ident.name id, pos) :: type_paths_sig env p pos' rem
-  | Tsig_module(id, mty) :: rem ->
+  | Tsig_module(id, mty, _) :: rem ->
       type_paths env (Pdot(p, Ident.name id, pos)) mty @
       type_paths_sig (Env.add_module id mty env) p (pos+1) rem
   | Tsig_modtype(id, decl) :: rem ->
@@ -183,3 +186,25 @@ and type_paths_sig env p pos sg =
       type_paths_sig env p (pos+1) rem
   | (Tsig_cltype _) :: rem ->
       type_paths_sig env p pos rem
+
+let rec no_code_needed env mty =
+  match scrape env mty with
+    Tmty_ident p -> false
+  | Tmty_signature sg -> no_code_needed_sig env sg
+  | Tmty_functor(_, _, _) -> false  
+
+and no_code_needed_sig env sg =
+  match sg with
+    [] -> true
+  | Tsig_value(id, decl) :: rem ->
+      begin match decl.val_kind with
+      | Val_prim _ -> no_code_needed_sig env rem
+      | _ -> false
+      end
+  | Tsig_module(id, mty, _) :: rem ->
+      no_code_needed env mty &&
+      no_code_needed_sig (Env.add_module id mty env) rem
+  | (Tsig_type _ | Tsig_modtype _ | Tsig_cltype _) :: rem ->
+      no_code_needed_sig env rem
+  | (Tsig_exception _ | Tsig_class _) :: rem ->
+      false
diff --git a/typing/mtype.mli b/typing/mtype.mli
index abb66b9696..b15b09ec9c 100644
--- a/typing/mtype.mli
+++ b/typing/mtype.mli
@@ -30,6 +30,10 @@ val nondep_supertype: Env.t -> Ident.t -> module_type -> module_type
         (* Return the smallest supertype of the given type
            in which the given ident does not appear.
            Raise [Not_found] if no such type exists. *)
+val no_code_needed: Env.t -> module_type -> bool
+val no_code_needed_sig: Env.t -> signature -> bool
+        (* Determine whether a module needs no implementation code,
+           i.e. consists only of type definitions. *)
 val enrich_modtype: Env.t -> Path.t -> module_type -> module_type
 val enrich_typedecl: Env.t -> Path.t -> type_declaration -> type_declaration
 val type_paths: Env.t -> Path.t -> module_type -> Path.t list
diff --git a/typing/oprint.ml b/typing/oprint.ml
index dc0447f008..9808979bb5 100644
--- a/typing/oprint.ml
+++ b/typing/oprint.ml
@@ -328,12 +328,14 @@ and print_out_signature ppf =
       fprintf ppf "%a@ %a" !out_sig_item item print_out_signature items
 and print_out_sig_item ppf =
   function
-    Osig_class (vir_flag, name, params, clt) ->
-      fprintf ppf "@[<2>class%s@ %a%s@ :@ %a@]"
+    Osig_class (vir_flag, name, params, clt, rs) ->
+      fprintf ppf "@[<2>%s%s@ %a%s@ :@ %a@]"
+        (if rs = Orec_next then "and" else "class")
         (if vir_flag then " virtual" else "") print_out_class_params params
         name !out_class_type clt
-  | Osig_class_type (vir_flag, name, params, clt) ->
-      fprintf ppf "@[<2>class type%s@ %a%s@ =@ %a@]"
+  | Osig_class_type (vir_flag, name, params, clt, rs) ->
+      fprintf ppf "@[<2>%s%s@ %a%s@ =@ %a@]"
+        (if rs = Orec_next then "and" else "class type")
         (if vir_flag then " virtual" else "") print_out_class_params params
         name !out_class_type clt
   | Osig_exception (id, tyl) ->
@@ -342,9 +344,16 @@ and print_out_sig_item ppf =
       fprintf ppf "@[<2>module type %s@]" name
   | Osig_modtype (name, mty) ->
       fprintf ppf "@[<2>module type %s =@ %a@]" name !out_module_type mty
-  | Osig_module (name, mty) ->
-      fprintf ppf "@[<2>module %s :@ %a@]" name !out_module_type mty
-  | Osig_type tdl -> print_out_type_decl_list ppf tdl
+  | Osig_module (name, mty, rs) ->
+      fprintf ppf "@[<2>%s %s :@ %a@]" 
+        (match rs with Orec_not -> "module"
+                     | Orec_first -> "module rec"
+                     | Orec_next -> "and")
+        name !out_module_type mty
+  | Osig_type(td, rs) ->
+        print_out_type_decl
+          (if rs = Orec_next then "and" else "type")
+          ppf td
   | Osig_value (name, ty, prims) ->
       let kwd = if prims = [] then "val" else "external" in
       let pr_prims ppf =
@@ -356,13 +365,7 @@ and print_out_sig_item ppf =
       in
       fprintf ppf "@[<2>%s %a :@ %a%a@]" kwd value_ident name !out_type
         ty pr_prims prims
-and print_out_type_decl_list ppf =
-  function
-    [] -> ()
-  | [x] -> print_out_type_decl "type" ppf x
-  | x :: l ->
-      print_out_type_decl "type" ppf x;
-      List.iter (fun x -> fprintf ppf "@ %a" (print_out_type_decl "and") x) l
+
 and print_out_type_decl kwd ppf (name, args, ty, constraints) =
   let print_constraints ppf params =
     List.iter
diff --git a/typing/outcometree.mli b/typing/outcometree.mli
index bb001f91ba..765e074617 100644
--- a/typing/outcometree.mli
+++ b/typing/outcometree.mli
@@ -82,16 +82,22 @@ type out_module_type =
   | Omty_ident of out_ident
   | Omty_signature of out_sig_item list
 and out_sig_item =
-  | Osig_class of bool * string * string list * out_class_type
-  | Osig_class_type of bool * string * string list * out_class_type
+  | Osig_class of
+      bool * string * string list * out_class_type * out_rec_status
+  | Osig_class_type of
+      bool * string * string list * out_class_type * out_rec_status
   | Osig_exception of string * out_type list
   | Osig_modtype of string * out_module_type
-  | Osig_module of string * out_module_type
-  | Osig_type of out_type_decl list
+  | Osig_module of string * out_module_type * out_rec_status
+  | Osig_type of out_type_decl * out_rec_status
   | Osig_value of string * out_type * string list
 and out_type_decl =
   string * (string * (bool * bool)) list * out_type *
   (out_type * out_type) list
+and out_rec_status =
+  | Orec_not
+  | Orec_first
+  | Orec_next
 
 type out_phrase =
   | Ophr_eval of out_value * out_type
diff --git a/typing/printtyp.ml b/typing/printtyp.ml
index d5561eb16a..4ff107fe32 100644
--- a/typing/printtyp.ml
+++ b/typing/printtyp.ml
@@ -69,6 +69,13 @@ let rec path ppf = function
   | Papply(p1, p2) ->
       fprintf ppf "%a(%a)" path p1 path p2
 
+(* Print a recursive annotation *)
+
+let tree_of_rec = function
+  | Trec_not -> Orec_not
+  | Trec_first -> Orec_first
+  | Trec_next -> Orec_next
+
 (* Print a raw type expression, with sharing *)
 
 let raw_list pr ppf = function
@@ -603,11 +610,11 @@ and tree_of_constructor (name, args) =
 and tree_of_label (name, mut, arg) =
   (name, mut = Mutable, tree_of_typexp false arg)
 
-let tree_of_type_declaration id decl =
-  Osig_type [tree_of_type_decl id decl]
+let tree_of_type_declaration id decl rs =
+  Osig_type (tree_of_type_decl id decl, tree_of_rec rs)
 
 let type_declaration id ppf decl =
-  !Oprint.out_sig_item ppf (tree_of_type_declaration id decl)
+  !Oprint.out_sig_item ppf (tree_of_type_declaration id decl Trec_first)
 
 (* Print an exception declaration *)
 
@@ -737,7 +744,7 @@ let tree_of_class_params = function
       let tyl = tree_of_typlist true params in
       List.map (function Otyp_var (_, s) -> s | _ -> "?") tyl
 
-let tree_of_class_declaration id cl =
+let tree_of_class_declaration id cl rs =
   let params = filter_params cl.cty_params in
 
   reset ();
@@ -752,12 +759,13 @@ let tree_of_class_declaration id cl =
   let vir_flag = cl.cty_new = None in
   Osig_class
     (vir_flag, Ident.name id, tree_of_class_params params,
-     tree_of_class_type true params cl.cty_type)
+     tree_of_class_type true params cl.cty_type,
+     tree_of_rec rs)
 
 let class_declaration id ppf cl =
-  !Oprint.out_sig_item ppf (tree_of_class_declaration id cl)
+  !Oprint.out_sig_item ppf (tree_of_class_declaration id cl Trec_first)
 
-let tree_of_cltype_declaration id cl =
+let tree_of_cltype_declaration id cl rs =
   let params = List.map repr cl.clty_params in
 
   reset ();
@@ -781,10 +789,11 @@ let tree_of_cltype_declaration id cl =
 
   Osig_class_type
     (virt, Ident.name id, tree_of_class_params params,
-     tree_of_class_type true params cl.clty_type)
+     tree_of_class_type true params cl.clty_type,
+     tree_of_rec rs)
 
 let cltype_declaration id ppf cl =
-  !Oprint.out_sig_item ppf (tree_of_cltype_declaration id cl)
+  !Oprint.out_sig_item ppf (tree_of_cltype_declaration id cl Trec_first)
 
 (* Print a module type *)
 
@@ -799,48 +808,25 @@ let rec tree_of_modtype = function
 
 and tree_of_signature = function
   | [] -> []
-  | item :: rem ->
-      match item with
-      | Tsig_value(id, decl) ->
-          tree_of_value_description id decl :: tree_of_signature rem
-      | Tsig_type(id, decl)  ->
-          let (type_decl_list, rem) =
-            let rec more_type_declarations = function
-            | Tsig_type(id, decl) :: rem ->
-                let (type_decl_list, rem) = more_type_declarations rem in
-                (id, decl) :: type_decl_list, rem
-            | rem -> [], rem in
-            more_type_declarations rem
-          in
-          let type_decl_list =
-            List.map (fun (id, decl) -> tree_of_type_decl id decl)
-              ((id, decl) :: type_decl_list)
-          in
-          Osig_type type_decl_list
-          ::
-          tree_of_signature rem
-      | Tsig_exception(id, decl)  ->
-          Osig_exception (Ident.name id, tree_of_typlist false decl) ::
-          tree_of_signature rem
-      | Tsig_module(id, mty)  ->
-          Osig_module (Ident.name id, tree_of_modtype mty) ::
-          tree_of_signature rem
-      | Tsig_modtype(id, decl)  ->
-          tree_of_modtype_declaration id decl :: tree_of_signature rem
-      | Tsig_class(id, decl) ->
-          let rem =
-            match rem with
-            | ctydecl :: tydecl1 :: tydecl2 :: rem -> rem
-            | _ -> []
-          in
-          tree_of_class_declaration id decl :: tree_of_signature rem
-      | Tsig_cltype(id, decl) ->
-          let rem =
-            match rem with
-            | tydecl1 :: tydecl2 :: rem -> rem
-            | _ -> []
-          in
-          tree_of_cltype_declaration id decl :: tree_of_signature rem
+  | Tsig_value(id, decl) :: rem ->
+      tree_of_value_description id decl :: tree_of_signature rem
+  | Tsig_type(id, decl, rs) :: rem ->
+      Osig_type(tree_of_type_decl id decl, tree_of_rec rs) ::
+      tree_of_signature rem
+  | Tsig_exception(id, decl) :: rem ->
+      Osig_exception (Ident.name id, tree_of_typlist false decl) ::
+      tree_of_signature rem
+  | Tsig_module(id, mty, rs) :: rem ->
+      Osig_module (Ident.name id, tree_of_modtype mty, tree_of_rec rs) ::
+      tree_of_signature rem
+  | Tsig_modtype(id, decl) :: rem ->
+      tree_of_modtype_declaration id decl :: tree_of_signature rem
+  | Tsig_class(id, decl, rs) :: ctydecl :: tydecl1 :: tydecl2 :: rem ->
+      tree_of_class_declaration id decl rs :: tree_of_signature rem
+  | Tsig_cltype(id, decl, rs) :: tydecl1 :: tydecl2 :: rem ->
+      tree_of_cltype_declaration id decl rs :: tree_of_signature rem
+  | _ ->
+      assert false
 
 and tree_of_modtype_declaration id decl =
   let mty =
@@ -850,7 +836,8 @@ and tree_of_modtype_declaration id decl =
   in
   Osig_modtype (Ident.name id, mty)
 
-let tree_of_module id mty = Osig_module (Ident.name id, tree_of_modtype mty)
+let tree_of_module id mty rs = 
+  Osig_module (Ident.name id, tree_of_modtype mty, tree_of_rec rs)
 
 let modtype ppf mty = !Oprint.out_module_type ppf (tree_of_modtype mty)
 let modtype_declaration id ppf decl =
@@ -879,11 +866,6 @@ let rec trace fst txt ppf = function
        (trace false txt) rem
   | _ -> ()
 
-let rec mismatch = function
-  | [(_, t); (_, t')] -> (t, t')
-  | _ :: _ :: rem -> mismatch rem
-  | _ -> assert false
-
 let rec filter_trace = function
   | (t1, t1') :: (t2, t2') :: rem ->
       let rem' = filter_trace rem in
@@ -906,12 +888,37 @@ let prepare_expansion (t, t') =
   mark_loops t; if t != t' then mark_loops t';
   (t, t')
 
+let may_prepare_expansion compact (t, t') =
+  match (repr t').desc with
+    Tvariant _ | Tobject _ when compact ->
+      mark_loops t; (t, t)
+  | _ -> prepare_expansion (t, t')
+
 let print_tags ppf fields =
   match fields with [] -> ()
   | (t, _) :: fields ->
       fprintf ppf "`%s" t;
       List.iter (fun (t, _) -> fprintf ppf ",@ `%s" t) fields
 
+let has_explanation unif t3 t4 =
+  match t3.desc, t4.desc with
+    Tfield _, _ | _, Tfield _
+  | Tunivar, Tvar | Tvar, Tunivar
+  | Tvariant _, Tvariant _ -> true
+  | Tconstr (p, _, _), Tvar | Tvar, Tconstr (p, _, _) ->
+      unif && min t3.level t4.level < Path.binding_time p
+  | _ -> false
+
+let rec mismatch unif = function
+    (_, t) :: (_, t') :: rem ->
+      begin match mismatch unif rem with
+        Some _ as m -> m
+      | None ->
+          if has_explanation unif t t' then Some(t,t') else None
+      end
+  | [] -> None
+  | _ -> assert false
+
 let explanation unif t3 t4 ppf =
   match t3.desc, t4.desc with
   | Tfield _, Tvar | Tvar, Tfield _ ->
@@ -933,6 +940,8 @@ let explanation unif t3 t4 ppf =
   | _, Tfield (lab, _, _, _) when lab = dummy_method ->
       fprintf ppf
         "@,Self type cannot be unified with a closed object type"
+  | Tfield (l, _, _, _), Tfield (l', _, _, _) when l = l' ->
+      fprintf ppf "@,Types for method %s are incompatible" l
   | Tfield (l, _, _, _), _ ->
       fprintf ppf
         "@,@[Only the first object type has a method %s@]" l
@@ -953,22 +962,29 @@ let explanation unif t3 t4 ppf =
           fprintf ppf
             "@,@[The second variant type does not allow tag(s)@ @[<hov>%a@]@]"
             print_tags fields
+      | [l1,_], true, [l2,_], true when l1 = l2 ->
+          fprintf ppf "@,Types for tag `%s are incompatible" l1
       | _ -> ()
       end
   | _ -> ()
 
+let explanation unif mis ppf =
+  match mis with
+    None -> ()
+  | Some (t3, t4) -> explanation unif t3 t4 ppf
+
 let unification_error unif tr txt1 ppf txt2 =
   reset ();
   let tr = List.map (fun (t, t') -> (t, hide_variant_name t')) tr in
-  let (t3, t4) = mismatch tr in
+  let mis = mismatch unif tr in
   match tr with
   | [] | _ :: [] -> assert false
   | t1 :: t2 :: tr ->
     try
-      let t1, t1' = prepare_expansion t1
-      and t2, t2' = prepare_expansion t2 in
-      print_labels := not !Clflags.classic;
       let tr = filter_trace tr in
+      let t1, t1' = may_prepare_expansion (tr = []) t1
+      and t2, t2' = may_prepare_expansion (tr = []) t2 in
+      print_labels := not !Clflags.classic;
       let tr = List.map prepare_expansion tr in
       fprintf ppf
         "@[<v>\
@@ -979,7 +995,7 @@ let unification_error unif tr txt1 ppf txt2 =
         txt1 (type_expansion t1) t1'
         txt2 (type_expansion t2) t2'
         (trace false "is not compatible with type") tr
-        (explanation unif t3 t4);
+        (explanation unif mis);
       print_labels := true
     with exn ->
       print_labels := true;
@@ -1006,6 +1022,6 @@ let report_subtyping_error ppf tr1 txt1 tr2 =
   and tr2 = List.map prepare_expansion tr2 in
   trace true txt1 ppf tr1;
   if tr2 = [] then () else
-  let t3, t4 = mismatch tr2 in
+  let mis = mismatch true tr2 in
   trace false "is not compatible with type" ppf tr2;
-  explanation true t3 t4 ppf
+  explanation true mis ppf
diff --git a/typing/printtyp.mli b/typing/printtyp.mli
index c02c13f0df..d645d15c08 100644
--- a/typing/printtyp.mli
+++ b/typing/printtyp.mli
@@ -37,19 +37,19 @@ val type_scheme_max: ?b_reset_names: bool ->
 (* Fin Maxence *)
 val tree_of_value_description: Ident.t -> value_description -> out_sig_item
 val value_description: Ident.t -> formatter -> value_description -> unit
-val tree_of_type_declaration: Ident.t -> type_declaration -> out_sig_item
+val tree_of_type_declaration: Ident.t -> type_declaration -> rec_status -> out_sig_item
 val type_declaration: Ident.t -> formatter -> type_declaration -> unit
 val tree_of_exception_declaration: Ident.t -> exception_declaration -> out_sig_item
 val exception_declaration: Ident.t -> formatter -> exception_declaration -> unit
-val tree_of_module: Ident.t -> module_type -> out_sig_item
+val tree_of_module: Ident.t -> module_type -> rec_status -> out_sig_item
 val modtype: formatter -> module_type -> unit
 val signature: formatter -> signature -> unit
 val tree_of_modtype_declaration: Ident.t -> modtype_declaration -> out_sig_item
 val modtype_declaration: Ident.t -> formatter -> modtype_declaration -> unit
 val class_type: formatter -> class_type -> unit
-val tree_of_class_declaration: Ident.t -> class_declaration -> out_sig_item
+val tree_of_class_declaration: Ident.t -> class_declaration -> rec_status -> out_sig_item
 val class_declaration: Ident.t -> formatter -> class_declaration -> unit
-val tree_of_cltype_declaration: Ident.t -> cltype_declaration -> out_sig_item
+val tree_of_cltype_declaration: Ident.t -> cltype_declaration -> rec_status -> out_sig_item
 val cltype_declaration: Ident.t -> formatter -> cltype_declaration -> unit
 val type_expansion: type_expr -> Format.formatter -> type_expr -> unit
 val prepare_expansion: type_expr * type_expr -> type_expr * type_expr
diff --git a/typing/subst.ml b/typing/subst.ml
index 4a2ffa1773..62e282a886 100644
--- a/typing/subst.ml
+++ b/typing/subst.ml
@@ -183,7 +183,11 @@ let type_declaration s decl =
 let class_signature s sign =
   { cty_self = typexp s sign.cty_self;
     cty_vars = Vars.map (function (m, t) -> (m, typexp s t)) sign.cty_vars;
-    cty_concr = sign.cty_concr }
+    cty_concr = sign.cty_concr;
+    cty_inher =
+      List.map (fun (p, tl) -> (type_path s p, List.map (typexp s) tl))
+        sign.cty_inher
+  }
 
 let rec class_type s =
   function
@@ -234,10 +238,10 @@ let exception_declaration s tyl =
 
 let rec rename_bound_idents s idents = function
     [] -> (List.rev idents, s)
-  | Tsig_type(id, d) :: sg ->
+  | Tsig_type(id, d, _) :: sg ->
       let id' = Ident.rename id in
       rename_bound_idents (add_type id (Pident id') s) (id' :: idents) sg
-  | Tsig_module(id, mty) :: sg ->
+  | Tsig_module(id, mty, _) :: sg ->
       let id' = Ident.rename id in
       rename_bound_idents (add_module id (Pident id') s) (id' :: idents) sg
   | Tsig_modtype(id, d) :: sg ->
@@ -245,7 +249,7 @@ let rec rename_bound_idents s idents = function
       rename_bound_idents (add_modtype id (Tmty_ident(Pident id')) s)
                           (id' :: idents) sg
   | (Tsig_value(id, _) | Tsig_exception(id, _) | 
-     Tsig_class(id, _) | Tsig_cltype(id, _)) :: sg ->
+     Tsig_class(id, _, _) | Tsig_cltype(id, _, _)) :: sg ->
       let id' = Ident.rename id in
       rename_bound_idents s (id' :: idents) sg
 
@@ -278,18 +282,18 @@ and signature_component s comp newid =
   match comp with
     Tsig_value(id, d) ->
       Tsig_value(newid, value_description s d)
-  | Tsig_type(id, d) ->
-      Tsig_type(newid, type_declaration s d)
+  | Tsig_type(id, d, rs) ->
+      Tsig_type(newid, type_declaration s d, rs)
   | Tsig_exception(id, d) ->
       Tsig_exception(newid, exception_declaration s d)
-  | Tsig_module(id, mty) ->
-      Tsig_module(newid, modtype s mty)
+  | Tsig_module(id, mty, rs) ->
+      Tsig_module(newid, modtype s mty, rs)
   | Tsig_modtype(id, d) ->
       Tsig_modtype(newid, modtype_declaration s d)
-  | Tsig_class(id, d) ->
-      Tsig_class(newid, class_declaration s d)
-  | Tsig_cltype(id, d) ->
-      Tsig_cltype(newid, cltype_declaration s d)
+  | Tsig_class(id, d, rs) ->
+      Tsig_class(newid, class_declaration s d, rs)
+  | Tsig_cltype(id, d, rs) ->
+      Tsig_cltype(newid, cltype_declaration s d, rs)
 
 and modtype_declaration s = function
     Tmodtype_abstract -> Tmodtype_abstract
diff --git a/typing/typeclass.ml b/typing/typeclass.ml
index 81f36b30ac..503a1098b5 100644
--- a/typing/typeclass.ml
+++ b/typing/typeclass.ml
@@ -88,9 +88,10 @@ let rec generalize_class_type =
     Tcty_constr (_, params, cty) ->
       List.iter Ctype.generalize params;
       generalize_class_type cty
-  | Tcty_signature {cty_self = sty; cty_vars = vars } ->
+  | Tcty_signature {cty_self = sty; cty_vars = vars; cty_inher = inher} ->
       Ctype.generalize sty;
-      Vars.iter (fun _ (_, ty) -> Ctype.generalize ty) vars
+      Vars.iter (fun _ (_, ty) -> Ctype.generalize ty) vars;
+      List.iter (fun (_,tl) -> List.iter Ctype.generalize tl) inher
   | Tcty_fun (_, ty, cty) ->
       Ctype.generalize ty;
       generalize_class_type cty
@@ -172,7 +173,9 @@ let rec limited_generalize rv =
   | Tcty_signature sign ->
       Ctype.limited_generalize rv sign.cty_self;
       Vars.iter (fun _ (_, ty) -> Ctype.limited_generalize rv ty)
-        sign.cty_vars
+        sign.cty_vars;
+      List.iter (fun (_, tl) -> List.iter (Ctype.limited_generalize rv) tl)
+        sign.cty_inher
   | Tcty_fun (_, ty, cty) ->
       Ctype.limited_generalize rv ty;
       limited_generalize rv cty
@@ -272,10 +275,15 @@ let make_method cl_num expr =
 
 (*******************************)
 
-let rec class_type_field env self_type meths (val_sig, concr_meths) =
+let rec class_type_field env self_type meths (val_sig, concr_meths, inher) =
   function
     Pctf_inher sparent ->
       let parent = class_type env sparent in
+      let inher =
+        match parent with
+          Tcty_constr (p, tl, _) -> (p, tl) :: inher
+        | _ -> inher
+      in
       let (cl_sig, concr_meths, _) =
         inheritance self_type env concr_meths Concr.empty sparent.pcty_loc
           parent
@@ -285,7 +293,7 @@ let rec class_type_field env self_type meths (val_sig, concr_meths) =
           (fun lab (mut, ty) val_sig -> Vars.add lab (mut, ty) val_sig)
           cl_sig.cty_vars val_sig
       in
-      (val_sig, concr_meths)
+      (val_sig, concr_meths, inher)
 
   | Pctf_val (lab, mut, sty_opt, loc) ->
       let (mut, ty) =
@@ -299,19 +307,19 @@ let rec class_type_field env self_type meths (val_sig, concr_meths) =
         | Some sty ->
             mut, transl_simple_type env false sty
       in
-      (Vars.add lab (mut, ty) val_sig, concr_meths)
+      (Vars.add lab (mut, ty) val_sig, concr_meths, inher)
 
   | Pctf_virt (lab, priv, sty, loc) ->
       declare_method env meths self_type lab priv sty loc;
-      (val_sig, concr_meths)
+      (val_sig, concr_meths, inher)
 
   | Pctf_meth (lab, priv, sty, loc)  ->
       declare_method env meths self_type lab priv sty loc;
-      (val_sig, Concr.add lab concr_meths)
+      (val_sig, Concr.add lab concr_meths, inher)
 
   | Pctf_cstr (sty, sty', loc) ->
       type_constraint env sty sty' loc;
-      (val_sig, concr_meths)
+      (val_sig, concr_meths, inher)
 
 and class_signature env sty sign =
   let meths = ref Meths.empty in
@@ -328,15 +336,16 @@ and class_signature env sty sign =
   end;
   
   (* Class type fields *)
-  let (val_sig, concr_meths) =
+  let (val_sig, concr_meths, inher) =
     List.fold_left (class_type_field env self_type meths)
-      (Vars.empty, Concr.empty)
+      (Vars.empty, Concr.empty, [])
       sign
   in
   
   {cty_self = self_type;
    cty_vars = val_sig;
-   cty_concr = concr_meths }
+   cty_concr = concr_meths;
+   cty_inher = inher}
 
 and class_type env scty =
   match scty.pcty_desc with
@@ -376,10 +385,16 @@ and class_type env scty =
 module StringSet = Set.Make(struct type t = string let compare = compare end)
 
 let rec class_field cl_num self_type meths vars
-    (val_env, met_env, par_env, fields, concr_meths, warn_meths, inh_vals) =
+    (val_env, met_env, par_env, fields, concr_meths, warn_meths,
+     inh_vals, inher) =
   function
     Pcf_inher (sparent, super) ->
       let parent = class_expr cl_num val_env par_env sparent in
+      let inher =
+        match parent.cl_type with
+          Tcty_constr (p, tl, _) -> (p, tl) :: inher
+        | _ -> inher
+      in
       let (cl_sig, concr_meths, warn_meths) =
         inheritance self_type val_env concr_meths warn_meths sparent.pcl_loc
           parent.cl_type
@@ -417,7 +432,7 @@ let rec class_field cl_num self_type meths vars
       in
       (val_env, met_env, par_env,
        lazy(Cf_inher (parent, inh_vars, inh_meths))::fields,
-       concr_meths, warn_meths, inh_vals)
+       concr_meths, warn_meths, inh_vals, inher)
 
   | Pcf_val (lab, mut, sexp, loc) ->
       if StringSet.mem lab inh_vals then
@@ -435,12 +450,13 @@ let rec class_field cl_num self_type meths vars
         enter_val cl_num vars lab mut exp.exp_type val_env met_env par_env
       in
       (val_env, met_env, par_env, lazy(Cf_val (lab, id, exp)) :: fields,
-       concr_meths, warn_meths, inh_vals)
+       concr_meths, warn_meths, inh_vals, inher)
 
   | Pcf_virt (lab, priv, sty, loc) ->
       virtual_method val_env meths self_type lab priv sty loc;
       let warn_meths = Concr.remove lab warn_meths in
-      (val_env, met_env, par_env, fields, concr_meths, warn_meths, inh_vals)
+      (val_env, met_env, par_env, fields, concr_meths, warn_meths,
+       inh_vals, inher)
 
   | Pcf_meth (lab, priv, expr, loc)  ->
       let (_, ty) =
@@ -483,11 +499,12 @@ let rec class_field cl_num self_type meths vars
           Cf_meth (lab, texp)
         end in
       (val_env, met_env, par_env, field::fields,
-       Concr.add lab concr_meths, Concr.add lab warn_meths, inh_vals)
+       Concr.add lab concr_meths, Concr.add lab warn_meths, inh_vals, inher)
 
   | Pcf_cstr (sty, sty', loc) ->
       type_constraint val_env sty sty' loc;
-      (val_env, met_env, par_env, fields, concr_meths, warn_meths, inh_vals)
+      (val_env, met_env, par_env, fields, concr_meths, warn_meths,
+       inh_vals, inher)
 
   | Pcf_let (rec_flag, sdefs, loc) ->
       let kset = Kset.empty () in (* FIXME *)
@@ -518,7 +535,7 @@ let rec class_field cl_num self_type meths vars
           ([], met_env, par_env)
       in
       (val_env, met_env, par_env, lazy(Cf_let(rec_flag, defs, vals))::fields,
-       concr_meths, warn_meths, inh_vals)
+       concr_meths, warn_meths, inh_vals, inher)
 
   | Pcf_init expr ->
       let expr = make_method cl_num expr in
@@ -535,22 +552,24 @@ let rec class_field cl_num self_type meths vars
           Cf_init texp
         end in
       (val_env, met_env, par_env, field::fields,
-       concr_meths, warn_meths, inh_vals)
+       concr_meths, warn_meths, inh_vals, inher)
 
 and class_structure cl_num final val_env met_env loc (spat, str) =
   (* Environment for substructures *)
   let par_env = met_env in
 
-  (* Private self type more method access, with a dummy method preventing
-     it from being closed/escaped. *)
+  (* Self type, with a dummy method preventing it from being closed/escaped. *)
   let self_type = Ctype.newvar () in
   Ctype.unify val_env
     (Ctype.filter_method val_env dummy_method Private self_type)
     (Ctype.newty (Ttuple []));
 
+  (* Private self is used for private method calls *)
+  let private_self = if final then Ctype.newvar () else self_type in
+
   (* Self binder *)
   let (pat, meths, vars, val_env, meth_env, par_env) =
-    type_self_pattern cl_num self_type val_env met_env par_env spat
+    type_self_pattern cl_num private_self val_env met_env par_env spat
   in
   let public_self = pat.pat_type in
 
@@ -569,30 +588,33 @@ and class_structure cl_num final val_env met_env loc (spat, str) =
     (* Copy known information to still empty self_type *)
     List.iter
       (fun (lab,kind,ty) ->
+        let k =
+          if Btype.field_kind_repr kind = Fpresent then Public else Private in
         try Ctype.unify val_env ty
-            (Ctype.filter_method val_env lab Public self_type)
+            (Ctype.filter_method val_env lab k self_type)
         with _ -> assert false)
       (get_methods public_self)
   end;
 
   (* Typing of class fields *)
-  let (_, _, _, fields, concr_meths, _, _) =
+  let (_, _, _, fields, concr_meths, _, _, inher) =
     List.fold_left (class_field cl_num self_type meths vars)
       (val_env, meth_env, par_env, [], Concr.empty, Concr.empty,
-       StringSet.empty)
+       StringSet.empty, [])
       str
   in
   Ctype.unify val_env self_type (Ctype.newvar ());
   let sign =
     {cty_self = public_self;
      cty_vars = Vars.map (function (id, mut, ty) -> (mut, ty)) !vars;
-     cty_concr = concr_meths } in
+     cty_concr = concr_meths;
+     cty_inher = inher} in
   let methods = get_methods self_type in
   let priv_meths =
     List.filter (fun (_,kind,_) -> Btype.field_kind_repr kind <> Fpresent)
       methods in
   if final then begin
-    (* Unify public_self and a copy of self_type. self_type will not
+    (* Unify private_self and a copy of self_type. self_type will not
        be modified after this point *)
     Ctype.close_object self_type;
     let mets = virtual_methods {sign with cty_self = self_type} in
@@ -600,11 +622,18 @@ and class_structure cl_num final val_env met_env loc (spat, str) =
     let self_methods =
       List.fold_right
         (fun (lab,kind,ty) rem ->
-          if lab = dummy_method then rem else
-          Ctype.newty(Tfield(lab, Btype.copy_kind kind, ty, rem)))
+          if lab = dummy_method then
+            (* allow public self and private self to be unified *)
+            match Btype.field_kind_repr kind with
+              Fvar r -> Btype.set_kind r Fabsent; rem
+            | _ -> rem
+          else
+            Ctype.newty(Tfield(lab, Btype.copy_kind kind, ty, rem)))
         methods (Ctype.newty Tnil) in
-    begin try Ctype.unify val_env public_self
-        (Ctype.newty (Tobject(self_methods, ref None)))
+    begin try
+      Ctype.unify val_env private_self
+        (Ctype.newty (Tobject(self_methods, ref None)));
+      Ctype.unify val_env public_self self_type
     with Ctype.Unify trace -> raise(Error(loc, Final_self_clash trace))
     end;
   end;
@@ -951,7 +980,8 @@ let rec initial_env define_class approx
     Tcty_signature
       { cty_self = Ctype.newvar ();
         cty_vars = Vars.empty;
-        cty_concr = Concr.empty }
+        cty_concr = Concr.empty;
+        cty_inher = [] }
   in
   let dummy_class =
     {cty_params = [];             (* Dummy value *)
diff --git a/typing/typecore.ml b/typing/typecore.ml
index ffc59e72f8..7cdbab5015 100644
--- a/typing/typecore.ml
+++ b/typing/typecore.ml
@@ -339,200 +339,194 @@ let build_or_pat env loc lid =
           pat pats in
       rp { r with pat_loc = loc }
 
-let type_pat ?(nonlinear=false) env sp =
-  let rec type_pat0 env sp =
-    match sp.ppat_desc with
-      Ppat_any ->
-        rp {
-          pat_desc = Tpat_any;
-          pat_loc = sp.ppat_loc;
-          pat_type = newvar();
-          pat_env = env },
-	[]
-    | Ppat_var name ->
-        let ty = newvar() in
-        let id = enter_variable sp.ppat_loc name ty in
-        rp {
-          pat_desc = Tpat_var id;
-          pat_loc = sp.ppat_loc;
-          pat_type = ty;
-          pat_env = env },
-	[]
-    | Ppat_alias(sq, name) ->
-        let q, nonlinears = type_pat0 env sq in
-        begin_def ();
-        let ty_var = build_as_type env q in
-        end_def ();
-        generalize ty_var;
-        let id = enter_variable sp.ppat_loc name ty_var in
-        rp {
-          pat_desc = Tpat_alias(q, id);
-          pat_loc = sp.ppat_loc;
-          pat_type = q.pat_type;
-          pat_env = env },
-	nonlinears
-    | Ppat_constant cst ->
-        rp {
-          pat_desc = Tpat_constant cst;
-          pat_loc = sp.ppat_loc;
-          pat_type = type_constant cst;
-          pat_env = env },
-	[]
-    | Ppat_tuple spl ->
-        let pl,nonlinearsl = 
-	  let pnonlinearsl = List.map (type_pat0 env) spl in
-	  List.map fst pnonlinearsl,
-	  List.map snd pnonlinearsl
-	in
-        rp {
-          pat_desc = Tpat_tuple pl;
-          pat_loc = sp.ppat_loc;
-          pat_type = newty (Ttuple(List.map (fun p -> p.pat_type) pl));
-          pat_env = env },
-	List.flatten nonlinearsl
-    | Ppat_construct(lid, sarg, explicit_arity) ->
-        let constr =
+let rec find_record_qual = function
+  | [] -> None
+  | (Longident.Ldot (modname, _), _) :: _ -> Some modname
+  | _ :: rest -> find_record_qual rest
+
+let type_label_a_list type_lid_a lid_a_list =
+  match find_record_qual lid_a_list with
+  | None -> List.map type_lid_a lid_a_list
+  | Some modname ->
+      List.map
+        (function
+         | (Longident.Lident id), sarg ->
+              type_lid_a (Longident.Ldot (modname, id), sarg)
+         | lid_a -> type_lid_a lid_a)
+        lid_a_list
+
+let nonlinear_variables = ref []
+let reset_nonlinear_variables () = nonlinear_variables := []
+
+let rec type_pat ?(nonlinear=false) env sp =
+  match sp.ppat_desc with
+    Ppat_any ->
+      rp {
+        pat_desc = Tpat_any;
+        pat_loc = sp.ppat_loc;
+        pat_type = newvar();
+        pat_env = env }
+  | Ppat_var name ->
+      let ty = newvar() in
+      let id = enter_variable sp.ppat_loc name ty in
+      rp {
+        pat_desc = Tpat_var id;
+        pat_loc = sp.ppat_loc;
+        pat_type = ty;
+        pat_env = env }
+  | Ppat_alias(sq, name) ->
+      let q = type_pat env sq in
+      begin_def ();
+      let ty_var = build_as_type env q in
+      end_def ();
+      generalize ty_var;
+      let id = enter_variable sp.ppat_loc name ty_var in
+      rp {
+        pat_desc = Tpat_alias(q, id);
+        pat_loc = sp.ppat_loc;
+        pat_type = q.pat_type;
+        pat_env = env }
+  | Ppat_constant cst ->
+      rp {
+        pat_desc = Tpat_constant cst;
+        pat_loc = sp.ppat_loc;
+        pat_type = type_constant cst;
+        pat_env = env }
+  | Ppat_tuple spl ->
+      let pl = List.map (type_pat env) spl in
+      rp {
+        pat_desc = Tpat_tuple pl;
+        pat_loc = sp.ppat_loc;
+        pat_type = newty (Ttuple(List.map (fun p -> p.pat_type) pl));
+        pat_env = env }
+  | Ppat_construct(lid, sarg, explicit_arity) ->
+      let constr =
+        try
+          Env.lookup_constructor lid env
+        with Not_found ->
+          raise(Error(sp.ppat_loc, Unbound_constructor lid)) in
+      let sargs =
+        match sarg with
+          None -> []
+        | Some {ppat_desc = Ppat_tuple spl} when explicit_arity -> spl
+        | Some {ppat_desc = Ppat_tuple spl} when constr.cstr_arity > 1 -> spl
+        | Some({ppat_desc = Ppat_any} as sp) when constr.cstr_arity > 1 ->
+            replicate_list sp constr.cstr_arity
+        | Some sp -> [sp] in
+      if List.length sargs <> constr.cstr_arity then
+        raise(Error(sp.ppat_loc, Constructor_arity_mismatch(lid,
+                                     constr.cstr_arity, List.length sargs)));
+      let args = List.map (type_pat env) sargs in
+      let (ty_args, ty_res) = instance_constructor constr in
+      List.iter2 (unify_pat env) args ty_args;
+      rp {
+        pat_desc = Tpat_construct(constr, args);
+        pat_loc = sp.ppat_loc;
+        pat_type = ty_res;
+        pat_env = env }
+  | Ppat_variant(l, sarg) ->
+      let arg = may_map (type_pat env) sarg in
+      let arg_type = match arg with None -> [] | Some arg -> [arg.pat_type]  in
+      let row = { row_fields =
+                    [l, Reither(arg = None, arg_type, true, ref None)];
+                  row_bound = arg_type;
+                  row_closed = false;
+                  row_more = newvar ();
+                  row_fixed = false;
+                  row_name = None } in
+      rp {
+        pat_desc = Tpat_variant(l, arg, row);
+        pat_loc = sp.ppat_loc;
+        pat_type = newty (Tvariant row);
+        pat_env = env }
+  | Ppat_record lid_sp_list ->
+      let rec check_duplicates = function
+        [] -> ()
+      | (lid, sarg) :: remainder ->
+          if List.mem_assoc lid remainder
+          then raise(Error(sp.ppat_loc, Label_multiply_defined lid))
+          else check_duplicates remainder in
+      check_duplicates lid_sp_list;
+      let ty = newvar() in
+      let type_label_pat (lid, sarg) =
+        let label =
           try
-            Env.lookup_constructor lid env
+            Env.lookup_label lid env
           with Not_found ->
-            raise(Error(sp.ppat_loc, Unbound_constructor lid)) in
-        let sargs =
-          match sarg with
-            None -> []
-          | Some {ppat_desc = Ppat_tuple spl} when explicit_arity -> spl
-          | Some {ppat_desc = Ppat_tuple spl} when constr.cstr_arity > 1 -> spl
-          | Some({ppat_desc = Ppat_any} as sp) when constr.cstr_arity > 1 ->
-              replicate_list sp constr.cstr_arity
-          | Some sp -> [sp] in
-        if List.length sargs <> constr.cstr_arity then
-          raise(Error(sp.ppat_loc, Constructor_arity_mismatch(lid,
-                                       constr.cstr_arity, List.length sargs)));
-        let args, nonlinearsl = 
-	  let argnonlinearsl = List.map (type_pat0 env) sargs in
-	  List.map fst argnonlinearsl,
-	  List.map snd argnonlinearsl
-	in
-        let (ty_args, ty_res) = instance_constructor constr in
-        List.iter2 (unify_pat env) args ty_args;
-        rp {
-          pat_desc = Tpat_construct(constr, args);
-          pat_loc = sp.ppat_loc;
-          pat_type = ty_res;
-          pat_env = env },
-	List.flatten nonlinearsl
-    | Ppat_variant(l, sarg) ->
-        let arg, nonlinears = 
-	  match may_map (type_pat0 env) sarg with
-	  | None -> None, []
-	  | Some (arg, nonlinears) -> Some arg, nonlinears
-	in
-        let arg_type = match arg with None -> [] | Some arg -> [arg.pat_type]  in
-        let row = { row_fields =
-                      [l, Reither(arg = None, arg_type, true, ref None)];
-                    row_bound = arg_type;
-                    row_closed = false;
-                    row_more = newvar ();
-                    row_fixed = false;
-                    row_name = None } in
-        rp {
-          pat_desc = Tpat_variant(l, arg, row);
-          pat_loc = sp.ppat_loc;
-          pat_type = newty (Tvariant row);
-          pat_env = env },
-	nonlinears
-    | Ppat_record lid_sp_list ->
-        let rec check_duplicates = function
-          [] -> ()
-        | (lid, sarg) :: remainder ->
-            if List.mem_assoc lid remainder
-            then raise(Error(sp.ppat_loc, Label_multiply_defined lid))
-            else check_duplicates remainder in
-        check_duplicates lid_sp_list;
-        let ty = newvar() in
-        let type_label_pat (lid, sarg) =
-          let label =
-            try
-              Env.lookup_label lid env
-            with Not_found ->
-              raise(Error(sp.ppat_loc, Unbound_label lid)) in
-          let (_, ty_arg, ty_res) = instance_label false label in
-          begin try
-            unify env ty_res ty
-          with Unify trace ->
-            raise(Error(sp.ppat_loc, Label_mismatch(lid, trace)))
-          end;
-          let arg, nonlinears = type_pat0 env sarg in
-          unify_pat env arg ty_arg;
-          (label, arg), nonlinears
-        in
-	let label_pat_list, nonlinearsl =
-	  let l = List.map type_label_pat lid_sp_list in
-	  List.map fst l, List.map snd l
-	in
-        rp {
-          pat_desc = Tpat_record label_pat_list;
-          pat_loc = sp.ppat_loc;
-          pat_type = ty;
-          pat_env = env },
-	List.flatten nonlinearsl 
-    | Ppat_array spl ->
-        let pl, nonlinearsl = 
-	  let l = List.map (type_pat0 env) spl in
-	  List.map fst l, List.map snd l
-	in
-        let ty_elt = newvar() in
-        List.iter (fun p -> unify_pat env p ty_elt) pl;
-        rp {
-          pat_desc = Tpat_array pl;
-          pat_loc = sp.ppat_loc;
-          pat_type = instance (Predef.type_array ty_elt);
-          pat_env = env },
-	List.flatten nonlinearsl
-    | Ppat_or(sp1, sp2) ->
-	let implicit_when_empty_check loc nonlinears =
-	  match nonlinears with
-	  | {Typertype.varinfo_name=n} :: _ ->
-	      raise (Error(loc, Orpat_with_non_linear_tvar n))
-	  | _ -> ()
-	in
-        let initial_pattern_variables = !pattern_variables in
-        let p1,nonlinears1 = type_pat0 env sp1 in
-	implicit_when_empty_check sp1.ppat_loc nonlinears1;
-        let p1_variables = !pattern_variables in
-        pattern_variables := initial_pattern_variables ;
-        let p2,nonlinears2 = type_pat0 env sp2 in
-	implicit_when_empty_check sp2.ppat_loc nonlinears2;
-        let p2_variables = !pattern_variables in
-        unify_pat env p2 p1.pat_type;
-        let alpha_env =
-          enter_orpat_variables sp.ppat_loc env p1_variables p2_variables in
-        pattern_variables := p1_variables ;
-        rp {
-          pat_desc = Tpat_or(p1, alpha_pat alpha_env p2, None);
-          pat_loc = sp.ppat_loc;
-          pat_type = p1.pat_type;
-          pat_env = env },
-	[] (* must be empty! *)
-    | Ppat_constraint(sp, sty) ->
-        let p, nonlinears = type_pat0 env sp in
-        let ty, force = Typetexp.transl_simple_type_delayed env sty in
-        unify_pat env p ty;
-        pattern_force := force :: !pattern_force;
-        p, nonlinears
-    | Ppat_type lid ->
-        build_or_pat env sp.ppat_loc lid, []
-    | Ppat_rtype sty ->
-        (* translate pattern *)
-        let sp, nonlinears = 
-	  Typertype.pattern_of_type nonlinear
-	    (fun lid -> fst (Env.lookup_type lid env)) sty 
-	in
-        let pat, internal_nonlinears = type_pat0 env sp in
-	assert (internal_nonlinears=[]);
-        unify_pat env pat (Typertype.get_rtype_type ());
-        pat, nonlinears
-  in
-  type_pat0 env sp
+            raise(Error(sp.ppat_loc, Unbound_label lid)) in
+        let (_, ty_arg, ty_res) = instance_label false label in
+        begin try
+          unify env ty_res ty
+        with Unify trace ->
+          raise(Error(sp.ppat_loc, Label_mismatch(lid, trace)))
+        end;
+        let arg = type_pat env sarg in
+        unify_pat env arg ty_arg;
+        (label, arg)
+      in
+      rp {
+        pat_desc = Tpat_record(type_label_a_list type_label_pat lid_sp_list);
+        pat_loc = sp.ppat_loc;
+        pat_type = ty;
+        pat_env = env }
+  | Ppat_array spl ->
+      let pl = List.map (type_pat env) spl in
+      let ty_elt = newvar() in
+      List.iter (fun p -> unify_pat env p ty_elt) pl;
+      rp {
+        pat_desc = Tpat_array pl;
+        pat_loc = sp.ppat_loc;
+        pat_type = instance (Predef.type_array ty_elt);
+        pat_env = env }
+  | Ppat_or(sp1, sp2) ->
+      let initial_pattern_variables = !pattern_variables in
+      let p1 = type_pat env sp1 in
+      let p1_variables = !pattern_variables in
+      pattern_variables := initial_pattern_variables ;
+      let p2 = type_pat env sp2 in
+      let p2_variables = !pattern_variables in
+      unify_pat env p2 p1.pat_type;
+      let alpha_env =
+        enter_orpat_variables sp.ppat_loc env p1_variables p2_variables in
+      pattern_variables := p1_variables ;
+      rp {
+        pat_desc = Tpat_or(p1, alpha_pat alpha_env p2, None);
+        pat_loc = sp.ppat_loc;
+        pat_type = p1.pat_type;
+        pat_env = env }
+  | Ppat_constraint(sp, sty) ->
+      let p = type_pat env sp in
+      let ty, force = Typetexp.transl_simple_type_delayed env sty in
+      unify_pat env p ty;
+      pattern_force := force :: !pattern_force;
+      p
+  | Ppat_type lid ->
+      build_or_pat env sp.ppat_loc lid
+  | Ppat_rtype sty ->
+      (* translate pattern *)
+      let sp, nonlinears = 
+	Typertype.pattern_of_type nonlinear
+	  (fun lid -> fst (Env.lookup_type lid env)) sty 
+      in
+      (* typing of the produced pattern. it must not contain
+	 nonlinear things! *)
+      (* escape and reset the nonlinear variable information *)
+      let escaped_nonlinear_variables = !nonlinear_variables in
+      reset_nonlinear_variables ();
+      (* type the produced pattern *)
+      let pat = type_pat env sp in
+      (* check it has no nonlinear variables *)
+      assert (!nonlinear_variables=[]);
+      (* recover the original nonlinear_variable information *)
+      nonlinear_variables := escaped_nonlinear_variables;
+      unify_pat env pat (Typertype.get_rtype_type ());
+      nonlinear_variables := nonlinears @ !nonlinear_variables;
+      pat
+
+let type_pat ?nonlinear env sp =
+  reset_nonlinear_variables ();
+  let p = type_pat ?nonlinear env sp in
+  p, !nonlinear_variables
 
 let get_ref r =
   let v = !r in r := []; v
@@ -678,9 +672,10 @@ let type_format loc fmt =
   and ty_result = newvar ()
   and ty_aresult = newvar () in
   let ty_arrow gty ty = newty (Tarrow ("", instance gty, ty, Cok)) in
-  let bad_format i len =
-    raise (Error (loc, Bad_format (String.sub fmt i len))) in
-  let incomplete i = bad_format i (len - i) in
+
+  let invalid_fmt s = raise (Error (loc, Bad_format s)) in
+  let incomplete i = invalid_fmt (String.sub fmt i (len - i)) in
+  let invalid i j = invalid_fmt (String.sub fmt i (j - i + 1)) in
 
   let rec scan_format i =
     if i >= len then ty_aresult, ty_result else
@@ -742,8 +737,7 @@ let type_format loc fmt =
       | '%' | '!' -> scan_format (j + 1)
       | 's' | 'S' | '[' -> conversion j Predef.type_string
       | 'c' | 'C' -> conversion j Predef.type_char
-      | 'd' | 'i' | 'o' | 'x' | 'X' | 'u' | 'N' ->
-          conversion j Predef.type_int
+      | 'd' | 'i' | 'o' | 'x' | 'X' | 'u' | 'N' -> conversion j Predef.type_int
       | 'f' | 'e' | 'E' | 'g' | 'G' | 'F' -> conversion j Predef.type_float
       | 'B' | 'b' -> conversion j Predef.type_bool
       | 'a' ->
@@ -752,24 +746,24 @@ let type_format loc fmt =
           let ty_aresult, ty_result = conversion j ty_arg in
           ty_aresult, ty_arrow ty_a ty_result
       | 't' -> conversion j (ty_arrow ty_input ty_aresult)
-      | 'n' when j + 1 = len -> conversion j Predef.type_int
-      | 'l' | 'n' | 'L' as conv ->
+      | 'n' | 'l' when j + 1 = len -> conversion j Predef.type_int
+      | 'n' | 'l' | 'L' as c ->
           let j = j + 1 in
           if j >= len then incomplete i else begin
-            match fmt.[j] with
-            | 'd' | 'i' | 'o' | 'x' | 'X' | 'u' ->
-                let ty_arg =
-                 match conv with
-                 | 'l' -> Predef.type_int32
-                 | 'n' -> Predef.type_nativeint
-                 | _ -> Predef.type_int64 in
-                conversion j ty_arg
-            | c ->
-               if conv = 'l' || conv = 'n'
-               then conversion (j - 1) Predef.type_int
-               else bad_format i (j - i)
+          match fmt.[j] with
+          | 'd' | 'i' | 'o' | 'x' | 'X' | 'u' ->
+             let ty_arg =
+               match c with
+               | 'l' -> Predef.type_int32
+               | 'n' -> Predef.type_nativeint
+               | _ -> Predef.type_int64 in
+              conversion j ty_arg
+          | _ ->
+             if c = 'l' || c = 'n'
+             then conversion (j - 1) Predef.type_int
+             else invalid i (j - i)
           end
-      | c -> bad_format i (j - i + 1) in
+      | c -> invalid i j in
     scan_width i j in
 
   let ty_ares, ty_res = scan_format 0 in
@@ -1038,7 +1032,7 @@ Format.fprintf Format.err_formatter "funct=%a@."
         if label.lbl_private = Private then
           raise(Error(sexp.pexp_loc, Private_type ty));
         (label, {arg with exp_type = instance arg.exp_type}) in
-      let lbl_exp_list = List.map type_label_exp lid_sexp_list in
+      let lbl_exp_list = type_label_a_list type_label_exp lid_sexp_list in
       let rec check_duplicates seen_pos lid_sexp lbl_exp =
         match (lid_sexp, lbl_exp) with
           ((lid, _) :: rem1, (lbl, _) :: rem2) ->
diff --git a/typing/typemod.ml b/typing/typemod.ml
index 390d1ed6d5..384156dddc 100644
--- a/typing/typemod.ml
+++ b/typing/typemod.ml
@@ -36,6 +36,8 @@ type error =
   | Non_generalizable of type_expr
   | Non_generalizable_class of Ident.t * class_declaration
   | Non_generalizable_module of module_type
+  | Implementation_is_required of string
+  | Interface_not_compiled of string
 
 exception Error of Location.t * error
 
@@ -71,20 +73,21 @@ let merge_constraint initial_env loc sg lid constr =
     match (sg, namelist, constr) with
       ([], _, _) ->
         raise(Error(loc, With_no_component lid))
-    | (Tsig_type(id, decl) :: rem, [s], Pwith_type sdecl)
+    | (Tsig_type(id, decl, rs) :: rem, [s], Pwith_type sdecl)
       when Ident.name id = s ->
         let newdecl = Typedecl.transl_with_constraint initial_env sdecl in
         Includemod.type_declarations env id newdecl decl;
-        Tsig_type(id, newdecl) :: rem
-    | (Tsig_module(id, mty) :: rem, [s], Pwith_module lid)
+        Tsig_type(id, newdecl, rs) :: rem
+    | (Tsig_module(id, mty, rs) :: rem, [s], Pwith_module lid)
       when Ident.name id = s ->
         let (path, mty') = type_module_path initial_env loc lid in
         let newmty = Mtype.strengthen env mty' path in
         ignore(Includemod.modtypes env newmty mty);
-        Tsig_module(id, newmty) :: rem
-    | (Tsig_module(id, mty) :: rem, s :: namelist, _) when Ident.name id = s ->
+        Tsig_module(id, newmty, rs) :: rem
+    | (Tsig_module(id, mty, rs) :: rem, s :: namelist, _)
+      when Ident.name id = s ->
         let newsg = merge env (extract_sig env loc mty) namelist in
-        Tsig_module(id, Tmty_signature newsg) :: rem
+        Tsig_module(id, Tmty_signature newsg, rs) :: rem
     | (item :: rem, _, _) ->
         item :: merge (Env.add_item item env) rem namelist in
   try
@@ -92,6 +95,14 @@ let merge_constraint initial_env loc sg lid constr =
   with Includemod.Error explanation ->
     raise(Error(loc, With_mismatch(lid, explanation)))
 
+(* Add recursion flags on declarations arising from a mutually recursive
+   block. *)
+
+let map_rec fn decls rem =
+  match decls with
+  | [] -> rem
+  | d1 :: dl -> fn Trec_first d1 :: map_end (fn Trec_next) dl rem
+
 (* Auxiliary for translating recursively-defined module types.
    Return a module type that approximates the shape of the given module
    type AST.  Retain only module, type, and module type
@@ -127,11 +138,11 @@ let approx_modtype transl_mty init_env smty =
         | Psig_type sdecls ->
             let decls = Typedecl.approx_type_decl env sdecls in
             let rem = approx_sig env srem in
-            map_end (fun (id, info) -> Tsig_type(id, info)) decls rem
+            map_rec (fun rs (id, info) -> Tsig_type(id, info, rs)) decls rem
         | Psig_module(name, smty) ->
             let mty = approx_mty env smty in
             let (id, newenv) = Env.enter_module name mty env in
-            Tsig_module(id, mty) :: approx_sig newenv srem
+            Tsig_module(id, mty, Trec_not) :: approx_sig newenv srem
         | Psig_recmodule sdecls ->
             let decls =
               List.map
@@ -141,7 +152,7 @@ let approx_modtype transl_mty init_env smty =
             let newenv =
               List.fold_left (fun env (id, mty) -> Env.add_module id mty env)
               env decls in
-            map_end (fun (id, mty) -> Tsig_module(id, mty)) decls
+            map_rec (fun rs (id, mty) -> Tsig_module(id, mty, rs)) decls
                     (approx_sig newenv srem)
         | Psig_modtype(name, sinfo) ->
             let info = approx_mty_info env sinfo in
@@ -162,11 +173,12 @@ let approx_modtype transl_mty init_env smty =
             let decls = Typeclass.approx_class_declarations env sdecls in
             let rem = approx_sig env srem in
             List.flatten
-              (List.map
-                (fun (i1, d1, i2, d2, i3, d3) ->
-                  [Tsig_cltype(i1, d1); Tsig_type(i2, d2); Tsig_type(i3, d3)])
-                decls)
-            @ rem
+              (map_rec
+                (fun rs (i1, d1, i2, d2, i3, d3) ->
+                  [Tsig_cltype(i1, d1, rs);
+                   Tsig_type(i2, d2, rs);
+                   Tsig_type(i3, d3, rs)])
+                decls [rem])
         | _ ->
             approx_sig env srem
 
@@ -203,9 +215,9 @@ let check cl loc set_ref name =
   else set_ref := StringSet.add name !set_ref
 
 let check_sig_item type_names module_names modtype_names loc = function
-    Tsig_type(id, _) ->
+    Tsig_type(id, _, _) ->
       check "type" loc type_names (Ident.name id)
-  | Tsig_module(id, _) ->
+  | Tsig_module(id, _, _) ->
       check "module" loc module_names (Ident.name id)
   | Tsig_modtype(id, _) ->
       check "module type" loc modtype_names (Ident.name id)
@@ -260,7 +272,7 @@ and transl_signature env sg =
               sdecls;
             let (decls, newenv) = Typedecl.transl_type_decl env sdecls in
             let rem = transl_sig newenv srem in
-            map_end (fun (id, info) -> Tsig_type(id, info)) decls rem
+            map_rec (fun rs (id, info) -> Tsig_type(id, info, rs)) decls rem
         | Psig_exception(name, sarg) ->
             let arg = Typedecl.transl_exception env sarg in
             let (id, newenv) = Env.enter_exception name arg env in
@@ -271,7 +283,7 @@ and transl_signature env sg =
             let mty = transl_modtype env smty in
             let (id, newenv) = Env.enter_module name mty env in
             let rem = transl_sig newenv srem in
-            Tsig_module(id, mty) :: rem
+            Tsig_module(id, mty, Trec_not) :: rem
         | Psig_recmodule sdecls ->
             List.iter
               (fun (name, smty) ->
@@ -280,7 +292,7 @@ and transl_signature env sg =
             let (decls, newenv) =
               transl_recmodule_modtypes item.psig_loc env sdecls in
             let rem = transl_sig newenv srem in
-            map_end (fun (id, mty) -> Tsig_module(id, mty)) decls rem
+            map_rec (fun rs (id, mty) -> Tsig_module(id, mty, rs)) decls rem
         | Psig_modtype(name, sinfo) ->
             check "module type" item.psig_loc modtype_names name;
             let info = transl_modtype_info env sinfo in
@@ -311,10 +323,12 @@ and transl_signature env sg =
             let (classes, newenv) = Typeclass.class_descriptions env cl in
             let rem = transl_sig newenv srem in
             List.flatten
-              (map_end
-                 (fun (i, d, i', d', i'', d'', i''', d''', _, _, _) ->
-                    [Tsig_class(i, d);    Tsig_cltype(i', d');
-                     Tsig_type(i'', d''); Tsig_type(i''', d''')])
+              (map_rec
+                 (fun rs (i, d, i', d', i'', d'', i''', d''', _, _, _) ->
+                    [Tsig_class(i, d, rs);
+                     Tsig_cltype(i', d', rs);
+                     Tsig_type(i'', d'', rs);
+                     Tsig_type(i''', d''', rs)])
                  classes [rem])
         | Psig_class_type cl ->
             List.iter
@@ -324,10 +338,11 @@ and transl_signature env sg =
             let (classes, newenv) = Typeclass.class_type_declarations env cl in
             let rem = transl_sig newenv srem in
             List.flatten
-              (map_end
-                 (fun (i, d, i', d', i'', d'') ->
-                    [Tsig_cltype(i, d);
-                     Tsig_type(i', d'); Tsig_type(i'', d'')])
+              (map_rec
+                 (fun rs (i, d, i', d', i'', d'') ->
+                    [Tsig_cltype(i, d, rs);
+                     Tsig_type(i', d', rs);
+                     Tsig_type(i'', d'', rs)])
                  classes [rem])
     in transl_sig env sg
 
@@ -378,7 +393,7 @@ let rec closed_modtype = function
 
 and closed_signature_item = function
     Tsig_value(id, desc) -> Ctype.closed_schema desc.val_type
-  | Tsig_module(id, mty) -> closed_modtype mty
+  | Tsig_module(id, mty, _) -> closed_modtype mty
   | _ -> true
 
 let check_nongen_scheme env = function
@@ -406,8 +421,8 @@ let rec bound_value_identifiers = function
   | Tsig_value(id, {val_kind = Val_reg}) :: rem ->
       id :: bound_value_identifiers rem
   | Tsig_exception(id, decl) :: rem -> id :: bound_value_identifiers rem
-  | Tsig_module(id, mty) :: rem -> id :: bound_value_identifiers rem
-  | Tsig_class(id, decl) :: rem -> id :: bound_value_identifiers rem
+  | Tsig_module(id, mty, _) :: rem -> id :: bound_value_identifiers rem
+  | Tsig_class(id, decl, _) :: rem -> id :: bound_value_identifiers rem
   | _ :: rem -> bound_value_identifiers rem
 
 (* Helpers for typing recursive modules *)
@@ -550,7 +565,7 @@ and type_structure anchor env kset sstr =
           enrich_type_decls anchor decls env newenv in
         let (str_rem, sig_rem, final_env) = type_struct newenv' srem in
         (Tstr_type decls :: str_rem,
-         map_end (fun (id, info) -> Tsig_type(id, info)) decls sig_rem,
+         map_rec (fun rs (id, info) -> Tsig_type(id, info, rs)) decls sig_rem,
          final_env)
     | {pstr_desc = Pstr_exception(name, sarg)} :: srem ->
         let arg = Typedecl.transl_exception env sarg in
@@ -573,7 +588,7 @@ and type_structure anchor env kset sstr =
         let (id, newenv) = Env.enter_module name mty env in
         let (str_rem, sig_rem, final_env) = type_struct newenv srem in
         (Tstr_module(id, modl) :: str_rem,
-         Tsig_module(id, modl.mod_type) :: sig_rem,
+         Tsig_module(id, modl.mod_type, Trec_not) :: sig_rem,
          final_env)
     | {pstr_desc = Pstr_recmodule sbind; pstr_loc = loc} :: srem ->
         List.iter
@@ -601,7 +616,7 @@ and type_structure anchor env kset sstr =
         let bind = List.map2 type_recmodule_binding decls sbind in
         let (str_rem, sig_rem, final_env) = type_struct newenv srem in
         (Tstr_recmodule bind :: str_rem,
-         map_end (fun (id, modl) -> Tsig_module(id, modl.mod_type))
+         map_rec (fun rs (id, modl) -> Tsig_module(id, modl.mod_type, rs))
                  bind sig_rem,
          final_env)
     | {pstr_desc = Pstr_modtype(name, smty); pstr_loc = loc} :: srem ->
@@ -633,10 +648,12 @@ and type_structure anchor env kset sstr =
            (List.map (fun (_,_,_,_,_,_, i, d, _,_,_) -> (i, d)) classes) ::
          str_rem,
          List.flatten
-           (map_end
-              (fun (i, d, i', d', i'', d'', i''', d''', _, _, _) ->
-                 [Tsig_class(i, d);    Tsig_cltype(i', d');
-                  Tsig_type(i'', d''); Tsig_type(i''', d''')])
+           (map_rec
+              (fun rs (i, d, i', d', i'', d'', i''', d''', _, _, _) ->
+                 [Tsig_class(i, d, rs);
+                  Tsig_cltype(i', d', rs);
+                  Tsig_type(i'', d'', rs);
+                  Tsig_type(i''', d''', rs)])
               classes [sig_rem]),
          final_env)
     | {pstr_desc = Pstr_class_type cl; pstr_loc = loc} :: srem ->
@@ -653,9 +670,11 @@ and type_structure anchor env kset sstr =
            (List.map (fun (_, _, _, _, i, d) -> (i, d)) classes) ::
          str_rem,
          List.flatten
-           (map_end
-              (fun (i, d, i', d', i'', d'') ->
-                 [Tsig_cltype(i, d); Tsig_type(i', d'); Tsig_type(i'', d'')])
+           (map_rec
+              (fun rs (i, d, i', d', i'', d'') ->
+                 [Tsig_cltype(i, d, rs);
+                  Tsig_type(i', d', rs);
+                  Tsig_type(i'', d'', rs)])
               classes [sig_rem]),
          final_env)
     | {pstr_desc = Pstr_include smodl; pstr_loc = loc} :: srem ->
@@ -693,7 +712,7 @@ and normalize_signature env = List.iter (normalize_signature_item env)
 
 and normalize_signature_item env = function
     Tsig_value(id, desc) -> Ctype.normalize_type env desc.val_type
-  | Tsig_module(id, mty) -> normalize_modtype env mty
+  | Tsig_module(id, mty, _) -> normalize_modtype env mty
   | _ -> ()
 
 (* Simplify multiple specifications of a value or an exception in a signature.
@@ -720,9 +739,9 @@ and simplify_signature sg =
       simplif val_names (StringSet.add name exn_names)
               (if StringSet.mem name exn_names then res else component :: res)
               sg
-  | Tsig_module(id, mty) :: sg ->
+  | Tsig_module(id, mty, rs) :: sg ->
       simplif val_names exn_names
-              (Tsig_module(id, simplify_modtype mty) :: res) sg
+              (Tsig_module(id, simplify_modtype mty, rs) :: res) sg
   | component :: sg ->
       simplif val_names exn_names (component :: res) sg
   in
@@ -730,12 +749,12 @@ and simplify_signature sg =
 
 (* Typecheck an implementation file *)
 
-let type_implementation sourcefile prefixname modulename initial_env ast =
+let type_implementation sourcefile outputprefix modulename initial_env ast =
   Typecore.reset_delayed_checks ();
   let kset = Kset.empty () in
   let (str, sg, finalenv) =
     Misc.try_finally (fun () -> type_structure initial_env kset ast)
-                     (fun () -> Stypes.dump (prefixname ^ ".annot"))
+                     (fun () -> Stypes.dump (outputprefix ^ ".annot"))
   in
   Typecore.force_delayed_checks (); (* We check kset emptyness here? *)
   if !Clflags.print_types then begin
@@ -743,17 +762,21 @@ let type_implementation sourcefile prefixname modulename initial_env ast =
     (str, Tcoerce_none)
   end else begin
     let coercion =
-      if Sys.file_exists (prefixname ^ !Config.interface_suffix) then begin
+      let sourceintf =
+        Misc.chop_extension_if_any sourcefile ^ !Config.interface_suffix in
+      if Sys.file_exists sourceintf then begin
         let intf_file =
-          try find_in_path !Config.load_path (prefixname ^ ".cmi")
-          with Not_found -> prefixname ^ ".cmi" in
+          try
+            find_in_path_uncap !Config.load_path (modulename ^ ".cmi")
+          with Not_found ->
+            raise(Error(Location.none, Interface_not_compiled sourceintf)) in
         let dclsig = Env.read_signature modulename intf_file in
         Includemod.compunit sourcefile sg intf_file dclsig
       end else begin
         check_nongen_schemes finalenv str;
         normalize_signature finalenv sg;
         if not !Clflags.dont_write_files then
-          Env.save_signature sg modulename (prefixname ^ ".cmi");
+          Env.save_signature sg modulename (outputprefix ^ ".cmi");
         Tcoerce_none
       end in
     (str, coercion)
@@ -768,7 +791,7 @@ let rec package_signatures subst = function
       let sg' = Subst.signature subst sg in
       let oldid = Ident.create_persistent name
       and newid = Ident.create name in
-      Tsig_module(newid, Tmty_signature sg') ::
+      Tsig_module(newid, Tmty_signature sg', Trec_not) ::
       package_signatures (Subst.add_module oldid (Pident newid) subst) rem
 
 let package_units objfiles cmifile modulename =
@@ -778,6 +801,10 @@ let package_units objfiles cmifile modulename =
       (fun f ->
          let pref = chop_extension_if_any f in
          let modname = String.capitalize(Filename.basename pref) in
+         let sg = Env.read_signature modname (pref ^ ".cmi") in
+         if Filename.check_suffix f ".cmi" &&
+            not(Mtype.no_code_needed_sig Env.initial sg)
+         then raise(Error(Location.none, Implementation_is_required f));
          (modname, Env.read_signature modname (pref ^ ".cmi")))
       objfiles in
   (* Compute signature of packaged unit *)
@@ -852,3 +879,10 @@ let report_error ppf = function
       fprintf ppf
         "@[The type of this module,@ %a,@ \
            contains type variables that cannot be generalized@]" modtype mty
+  | Implementation_is_required intf_name ->
+      fprintf ppf
+        "@[The interface %s@ declares values, not just types.@ \
+           An implementation must be provided.@]" intf_name
+  | Interface_not_compiled intf_name ->
+      fprintf ppf
+        "@[Could not find the .cmi file for interface@ %s.@]" intf_name
diff --git a/typing/typemod.mli b/typing/typemod.mli
index b0f5de65ab..d43f490242 100644
--- a/typing/typemod.mli
+++ b/typing/typemod.mli
@@ -48,6 +48,8 @@ type error =
   | Non_generalizable of type_expr
   | Non_generalizable_class of Ident.t * class_declaration
   | Non_generalizable_module of module_type
+  | Implementation_is_required of string
+  | Interface_not_compiled of string
 
 exception Error of Location.t * error
 
diff --git a/typing/types.ml b/typing/types.ml
index c5a179d099..4e8cc9083c 100644
--- a/typing/types.ml
+++ b/typing/types.ml
@@ -165,7 +165,8 @@ type class_type =
 and class_signature =
   { cty_self: type_expr;
     cty_vars: (Asttypes.mutable_flag * type_expr) Vars.t;
-    cty_concr: Concr.t }
+    cty_concr: Concr.t;
+    cty_inher: (Path.t * type_expr list) list }
 
 type class_declaration =
   { cty_params: type_expr list;
@@ -189,13 +190,18 @@ and signature = signature_item list
 
 and signature_item =
     Tsig_value of Ident.t * value_description
-  | Tsig_type of Ident.t * type_declaration
+  | Tsig_type of Ident.t * type_declaration * rec_status
   | Tsig_exception of Ident.t * exception_declaration
-  | Tsig_module of Ident.t * module_type
+  | Tsig_module of Ident.t * module_type * rec_status
   | Tsig_modtype of Ident.t * modtype_declaration
-  | Tsig_class of Ident.t * class_declaration
-  | Tsig_cltype of Ident.t * cltype_declaration
+  | Tsig_class of Ident.t * class_declaration * rec_status
+  | Tsig_cltype of Ident.t * cltype_declaration * rec_status
 
 and modtype_declaration =
     Tmodtype_abstract
   | Tmodtype_manifest of module_type
+
+and rec_status =
+    Trec_not
+  | Trec_first
+  | Trec_next
diff --git a/typing/types.mli b/typing/types.mli
index 93ca3079c0..8d3408bf86 100644
--- a/typing/types.mli
+++ b/typing/types.mli
@@ -167,7 +167,8 @@ type class_type =
 and class_signature =
   { cty_self: type_expr;
     cty_vars: (Asttypes.mutable_flag * type_expr) Vars.t;
-    cty_concr: Concr.t }
+    cty_concr: Concr.t;
+    cty_inher: (Path.t * type_expr list) list }
 
 type class_declaration =
   { cty_params: type_expr list;
@@ -191,13 +192,18 @@ and signature = signature_item list
 
 and signature_item =
     Tsig_value of Ident.t * value_description
-  | Tsig_type of Ident.t * type_declaration
+  | Tsig_type of Ident.t * type_declaration * rec_status
   | Tsig_exception of Ident.t * exception_declaration
-  | Tsig_module of Ident.t * module_type
+  | Tsig_module of Ident.t * module_type * rec_status
   | Tsig_modtype of Ident.t * modtype_declaration
-  | Tsig_class of Ident.t * class_declaration
-  | Tsig_cltype of Ident.t * cltype_declaration
+  | Tsig_class of Ident.t * class_declaration * rec_status
+  | Tsig_cltype of Ident.t * cltype_declaration * rec_status
 
 and modtype_declaration =
     Tmodtype_abstract
   | Tmodtype_manifest of module_type
+
+and rec_status =
+    Trec_not                            (* not recursive *)
+  | Trec_first                          (* first in a recursive group *)
+  | Trec_next                           (* not first in a recursive group *)
diff --git a/utils/ccomp.ml b/utils/ccomp.ml
index 1e065666bc..f98ba6985d 100644
--- a/utils/ccomp.ml
+++ b/utils/ccomp.ml
@@ -25,7 +25,7 @@ let command cmdline =
 let run_command cmdline = ignore(command cmdline)
 
 (* Build @responsefile to work around Windows limitations on 
-   command-length line *)
+   command-line length *)
 let build_diversion lst =
   let (responsefile, oc) = Filename.open_temp_file "camlresp" "" in
   List.iter
diff --git a/utils/config.mlp b/utils/config.mlp
index 370adbc387..599f5eca1c 100644
--- a/utils/config.mlp
+++ b/utils/config.mlp
@@ -39,12 +39,12 @@ let binutils_nm = "%%BINUTILS_NM%%"
 let binutils_objcopy = "%%BINUTILS_OBJCOPY%%"
 let cc_profile = "%%CC_PROFILE%%"
 
-let exec_magic_number = "Caml1999X007"
-and cmi_magic_number = "Caml1999I009"
-and cmo_magic_number = "Caml1999O005"
-and cma_magic_number = "Caml1999A006"
-and cmx_magic_number = "Caml1999Y008"
-and cmxa_magic_number = "Caml1999Z009"
+let exec_magic_number = "Caml1999X008"
+and cmi_magic_number = "Caml1999I010"
+and cmo_magic_number = "Caml1999O006"
+and cma_magic_number = "Caml1999A007"
+and cmx_magic_number = "Caml1999Y009"
+and cmxa_magic_number = "Caml1999Z010"
 and ast_impl_magic_number = "Caml1999M010"
 and ast_intf_magic_number = "Caml1999N009"
 
diff --git a/utils/misc.ml b/utils/misc.ml
index e142ce2ad2..989c313bb2 100644
--- a/utils/misc.ml
+++ b/utils/misc.ml
@@ -154,10 +154,7 @@ let no_overflow_lsl a = min_int asr 1 <= a && a <= max_int asr 1
 (* String operations *)
 
 let chop_extension_if_any fname =
-  try
-    ignore(String.index (Filename.basename fname) '.');
-    Filename.chop_extension fname
-  with Not_found -> fname
+  try Filename.chop_extension fname with Invalid_argument _ -> fname
 
 let search_substring pat str start =
   let rec search i j =
diff --git a/win32caml/Makefile b/win32caml/Makefile
index 397448c429..498e4dc5f6 100644
--- a/win32caml/Makefile
+++ b/win32caml/Makefile
@@ -18,7 +18,8 @@ include ../config/Makefile
 CC=$(BYTECC)
 CFLAGS=$(BYTECCCOMPOPTS)
 
-OBJS=startocaml.$(O) ocamlres.$(O) ocaml.$(O) menu.$(O)
+OBJS=startocaml.$(O) ocamlres.$(O) ocaml.$(O) menu.$(O) \
+  history.$(O) editbuffer.$(O)
 
 LIBS=$(call SYSLIB,kernel32) $(call SYSLIB,advapi32) $(call SYSLIB,gdi32) \
      $(call SYSLIB,user32) $(call SYSLIB,comdlg32) $(call SYSLIB,comctl32)
@@ -38,7 +39,7 @@ ifeq ($(TOOLCHAIN),mingw)
 	windres -i ocaml.rc -o $@
 endif
 
-$(OBJS): inria.h inriares.h
+$(OBJS): inria.h inriares.h history.h editbuffer.h
 
 clean:
 	rm -f ocamlwin.exe *.$(O) *.pdb ocamlwin.ilk
diff --git a/win32caml/inria.h b/win32caml/inria.h
index afa252404c..13949d52d5 100644
--- a/win32caml/inria.h
+++ b/win32caml/inria.h
@@ -56,8 +56,12 @@
                 something in the pipe. This is enough for most
                 applications.
 ------------------------------------------------------------------------*/
+#ifndef _INRIA_H_
+#define _INRIA_H_
 
 #include <windows.h>
+#include "editbuffer.h"
+#include "history.h"
 
 // In this structure should go eventually all global variables scattered
 // through the program.
@@ -90,26 +94,33 @@ void HandleCommand(HWND hwnd, WPARAM wParam,LPARAM lParam);
 int GetOcamlPath(void);                         // Finds where ocaml.exe is
 void ForceRepaint(void);                        // Ditto.
 void AddLineToControl(char *buf);
+void AddStringToControl(char* buf);
 char *GetHistoryLine(int n);            // Gets the nth history line base 1.
 int StartOcaml(void);
+void InterruptOcaml(void);
+int ResetText(void);
+BOOL SendingFullCommand(void);
+void RewriteCurrentEditBuffer(void);
+void RefreshCurrentEditBuffer(void);
+
 // **************** User defined window messages *************
-#define WM_NEWLINE      (WM_USER+6000)
-#define WM_TIMERTICK (WM_USER+6001)
-#define WM_QUITOCAML (WM_USER+6002)
+#define WM_NEWLINE		(WM_USER+6000)
+#define WM_TIMERTICK	(WM_USER+6001)
+#define WM_QUITOCAML	(WM_USER+6002)
+#define WM_SYNTAXERROR	(WM_USER+6003)
+#define WM_UNBOUNDVAL	(WM_USER+6004)
+#define WM_ILLEGALCHAR	(WM_USER+6005)
+
 // ********************** Structures ***********************
 typedef struct tagPosition {
         int line;
         int col;
 } POSITION;
 
-// Simple linked list for holding the history lines
-typedef struct tagHistory {
-        struct tagHistory *Next;
-        char *Text;
-} HISTORYLINE;
-
 extern void *SafeMalloc(int);
-extern HISTORYLINE *History; // The root of the history lines
+extern StatementHistory *History; // The root of the history lines
+extern StatementHistory *HistoryTail; // The tail of the history lines
+extern EditBuffer *CurrentEditBuffer; // current edit buffer
 
 #define IDEDITCONTROL 15432
-
+#endif
diff --git a/win32caml/menu.c b/win32caml/menu.c
index 34815d89f2..6ed736f732 100644
--- a/win32caml/menu.c
+++ b/win32caml/menu.c
@@ -10,6 +10,11 @@
 /*                                                                     */
 /***********************************************************************/
 
+/***********************************************************************/
+/* Changes made by Chris Watford to enhance the source editor          */
+/* Began 14 Sept 2003 - watford@uiuc.edu                               */
+/***********************************************************************/
+
 /* $Id$ */
 
 #include <stdio.h>
@@ -17,12 +22,13 @@
 #include <Richedit.h>
 #include "inria.h"
 #include "inriares.h"
+#include "history.h"
 
-void InterruptOcaml(void);
 LOGFONT CurrentFont;
 int CurrentFontFamily = (FIXED_PITCH | FF_MODERN);
 int CurrentFontStyle;
 char CurrentFontName[64] = "Courier";
+
 /*------------------------------------------------------------------------
  Procedure:     OpenMlFile ID:1
  Purpose:       Opens a file, either a source file (*.ml) or an *.cmo
@@ -68,6 +74,7 @@ int OpenMlFile(char *fname,int lenbuf)
         }
         return r;
 }
+
 /*------------------------------------------------------------------------
  Procedure:     GetSaveName ID:1
  Purpose:       Get a name to save the current session (Save as menu
@@ -111,6 +118,51 @@ int GetSaveName(char *fname,int lenbuf)
                 return 0;
         else return 1;
 }
+
+/*------------------------------------------------------------------------
+ Procedure:     GetSaveMLName ID:1
+ Purpose:       Get a name to save the current OCaml code to (Save as menu
+                item)
+ Input:         A buffer where the name of the file will be stored,
+                and its length
+ Output:        The name of the file choosen by the user will be
+                stored in the buffer
+ Errors:        none
+------------------------------------------------------------------------*/
+int GetSaveMLName(char *fname, int lenbuf)
+{
+        OPENFILENAME ofn;
+        int r;
+        char *p,defext[5],tmp[512];
+
+        memset(&ofn,0,sizeof(OPENFILENAME));
+        memset(tmp,0,sizeof(tmp));
+        fname[0] = 0;
+        strcpy(tmp,"OCaml Source Files|*.ml");
+        p = tmp;
+        while (*p) {
+                if (*p == '|')
+                        *p = 0;
+                p++;
+        }
+        strcpy(defext,"ml");
+        ofn.lStructSize = sizeof(OPENFILENAME);
+        ofn.hwndOwner = hwndMain;
+        ofn.lpstrFilter = tmp;
+        ofn.nFilterIndex = 1;
+        ofn.hInstance = hInst;
+        ofn.lpstrFile = fname;
+        ofn.lpstrTitle = "Save as";
+        ofn.lpstrInitialDir = LibDir;
+        ofn.nMaxFile = lenbuf;
+        ofn.Flags =  OFN_NOCHANGEDIR | OFN_LONGNAMES |
+                OFN_HIDEREADONLY |OFN_EXPLORER;
+        r = GetSaveFileName(&ofn);
+        if (r == 0)
+                return 0;
+        else return 1;
+}
+
 /*------------------------------------------------------------------------
  Procedure:     BrowseForFile ID:1
  Purpose:       Let's the user browse for a certain kind of file.
@@ -304,6 +356,13 @@ void ForceRepaint(void)
         InvalidateRect(hwndEdit,NULL,1);
 }
 
+/*------------------------------------------------------------------------
+ Procedure:     Add_Char_To_Queue ID:1
+ Purpose:       Puts a character onto the buffer
+ Input:         The char to be added
+ Output:        None
+ Errors:
+------------------------------------------------------------------------*/
 static void Add_Char_To_Queue(int c)
 {
         HWND hwndEdit = (HWND)GetWindowLong(hwndSession,DWL_USER);
@@ -326,13 +385,47 @@ void AddLineToControl(char *buf)
 
         if (*buf == 0)
                 return;
+
         hEditCtrl = (HWND)GetWindowLong(hwndSession,DWL_USER);
+
         GotoEOF();
+
         SendMessage(hEditCtrl,EM_REPLACESEL,0,(LPARAM)buf);
         SendMessage(hEditCtrl,WM_CHAR,'\r',0);
 }
 
 /*------------------------------------------------------------------------
+ Procedure:     AddStringToControl ID:1
+ Author:		Chris Watford watford@uiuc.edu
+ Purpose:       It will ad the given text at the end of the edit
+                control. This simulates user input. The history will not
+				be modified by this procedure.
+ Input:         The text to be added
+ Output:        None
+ Errors:        If the line is empty, nothing will be done
+--------------------------------------------------------------------------
+Edit History:
+	16 Sept 2003 - Chris Watford watford@uiuc.edu
+		- Basically this is AddLineToControl, but without appending a
+		  newline
+------------------------------------------------------------------------*/
+void AddStringToControl(char* buf)
+{
+        HWND hEditCtrl;
+
+		if(buf == NULL)
+			return;
+
+        if((*buf) == 0)
+            return;
+
+        hEditCtrl = (HWND)GetWindowLong(hwndSession, DWL_USER);
+        GotoEOF();
+
+        SendMessage(hEditCtrl ,EM_REPLACESEL, (WPARAM)FALSE, (LPARAM)buf);
+}
+
+/*------------------------------------------------------------------------
  Procedure:     AboutDlgProc ID:1
  Purpose:       Shows the "About" dialog box
  Input:
@@ -345,6 +438,7 @@ static BOOL CALLBACK AboutDlgProc(HWND hDlg, UINT message, WPARAM wParam, LPARAM
                 EndDialog(hDlg,1);
         return 0;
 }
+
 /*------------------------------------------------------------------------
  Procedure:     HistoryDlgProc ID:1
  Purpose:       Shows the history of the session. Only input lines
@@ -355,24 +449,33 @@ static BOOL CALLBACK AboutDlgProc(HWND hDlg, UINT message, WPARAM wParam, LPARAM
  Input:         Normal windows callback
  Output:
  Errors:
+--------------------------------------------------------------------------
+Edit History:
+	15 Sept 2003 - Chris Watford watford@uiuc.edu
+		- Added support for my StatementHistory structure
+		- Added the ability to export it as its exact entry, rather than
+		  just a 1 liner
 ------------------------------------------------------------------------*/
 static BOOL CALLBACK HistoryDlgProc(HWND hDlg, UINT message, WPARAM wParam, LPARAM lParam)
 {
-        HISTORYLINE *rvp;
+        StatementHistory *histentry;
         int idx;
         RECT rc;
 
         switch (message) {
                 case WM_INITDIALOG:
                         SendDlgItemMessage(hDlg,IDLIST,WM_SETFONT,(WPARAM)ProgramParams.hFont,0);
-                        rvp = History;
+                        histentry = History; // get our statement history object
                         idx = 0;
-                        while (rvp) {
-                                SendDlgItemMessage(hDlg,IDLIST,LB_INSERTSTRING,0,(LPARAM)rvp->Text);
+
+						// loop through each history entry adding it to the dialog
+                        while (histentry != NULL) {
+                                SendDlgItemMessage(hDlg,IDLIST,LB_INSERTSTRING,0,(LPARAM)editbuffer_getasline(histentry->Statement));
                                 SendDlgItemMessage(hDlg,IDLIST,LB_SETITEMDATA,0,(LPARAM)idx);
-                                rvp = rvp->Next;
+                                histentry = histentry->Next;
                                 idx++;
                         }
+
                         SendDlgItemMessage(hDlg,IDLIST,LB_SETCURSEL,(LPARAM)idx-1,0);
                         return 1;
                 case WM_COMMAND:
@@ -401,6 +504,7 @@ static BOOL CALLBACK HistoryDlgProc(HWND hDlg, UINT message, WPARAM wParam, LPAR
         }
         return 0;
 }
+
 /*------------------------------------------------------------------------
  Procedure:     SaveText ID:1
  Purpose:       Saves the contents of the session transcript. It will
@@ -409,6 +513,10 @@ static BOOL CALLBACK HistoryDlgProc(HWND hDlg, UINT message, WPARAM wParam, LPAR
  Output:        The session is saved
  Errors:        If it can't open the file for writing it will show an
                 error box
+--------------------------------------------------------------------------
+ Edit History:
+	06 Oct  2003 - Chris Watford watford@uiuc.edu
+		- Corrected wsprintf error
 ------------------------------------------------------------------------*/
 static void SaveText(char *fname)
 {
@@ -419,54 +527,155 @@ static void SaveText(char *fname)
         char *buf = SafeMalloc(8192);
 
         f = fopen(fname,"wb");
-        if (f == NULL) {
-                wsprintf("Impossible to open %s for writing",fname);
-                ShowDbgMsg(buf);
-                return;
+        if (f == NULL)
+		{
+			// corrected error using wsprintf
+            wsprintf(buf, "Impossible to open %s for writing", fname);
+
+            ShowDbgMsg(buf);
+            return;
         }
-        for (i=0; i<linesCount;i++) {
+
+        for (i = 0; i < linesCount; i++)
+		{
                 *(unsigned short *)buf = 8100;
-                len = SendMessage(hEdit,EM_GETLINE,i,(LPARAM)buf);
-                buf[len] = 0;
-                strcat(buf,"\r\n");
-                fwrite(buf,1,len+2,f);
+                len = SendMessage(hEdit, EM_GETLINE, i, (LPARAM)buf);
+                buf[len] = '\0';
+				fprintf(f, "%s\r\n", buf+1);
+                //fwrite(buf,1,len+2,f);
         }
+
         fclose(f);
         free(buf);
 }
 
+/*------------------------------------------------------------------------
+ Procedure:     SaveML ID:1
+ Author:		Chris Watford watford@uiuc.edu
+ Purpose:       Saves the ML source to a file, commenting out functions
+				that contained errors
+ Input:         The name of the file where the session will be saved
+ Output:        The session is saved
+ Errors:        If it can't open the file for writing it will show an
+                error box
+------------------------------------------------------------------------*/
+static void SaveML(char *fname)
+{
+        FILE *f;
+        char *buf = SafeMalloc(8192);
+
+        f = fopen(fname, "wb");
+
+        if(f == NULL)
+		{
+                wsprintf(buf, "Impossible to open %s for writing", fname);
+                ShowDbgMsg(buf);
+                return;
+        }
+
+		fprintf(f, "(* %s *)\r\n\r\n", fname);
+
+		if(History != NULL)
+		{
+			StatementHistory *h = NULL;
+			EditBuffer *stmt = NULL;
+
+			// get to the end
+			for(h = History; h->Next != NULL; h = h->Next);
+
+			// go back :(
+			// this is NOT the fastest method, BUT this is the easiest
+			// on the subsystem
+			for(; h != NULL; h = h->Prev)
+			{
+				stmt = h->Statement;
+
+				if(stmt != NULL)
+				{
+					// comment out incorrect lines
+					if(stmt->isCorrect)
+					{
+						char *buff = editbuffer_getasbuffer(stmt);
+						fprintf(f, "%s\r\n", buff);
+						free(buff);
+					} else {
+						char *buff = editbuffer_getasbuffer(stmt);
+						fprintf(f, "(* Syntax Error or Unbound Value\r\n%s\r\n *)\r\n", buff);
+						free(buff);
+					}
+				}
+
+				fprintf(f, "\r\n");
+			}
+		}
+
+        fclose(f);
+        free(buf);
+}
 
+/*------------------------------------------------------------------------
+ Procedure:     Add_Clipboard_To_Queue ID:1
+ Author:		Chris Watford watford@uiuc.edu
+ Purpose:       Adds the clipboard text to the control
+ Input:
+ Output:
+ Errors:
+--------------------------------------------------------------------------
+ Edit History:
+	16 Sept 2003 - Chris Watford watford@uiuc.edu
+		- Added method to update edit buffer with paste contents
+------------------------------------------------------------------------*/
 static void Add_Clipboard_To_Queue(void)
 {
-    if (IsClipboardFormatAvailable(CF_TEXT) &&
-        OpenClipboard(hwndMain))
+    if (IsClipboardFormatAvailable(CF_TEXT) && OpenClipboard(hwndMain))
     {
         HANDLE hClipData = GetClipboardData(CF_TEXT);
 
-        if (hClipData)
+        if (hClipData != NULL)
         {
             char *str = GlobalLock(hClipData);
 
-            if (str)
-                while (*str)
+            if (str != NULL)
+			{
+                while ((*str) != 0)
                 {
                     if (*str != '\r')
                         Add_Char_To_Queue(*str);
+
                     str++;
                 }
+
+				// added to fix odd errors
+				RefreshCurrentEditBuffer();
+			}
+
             GlobalUnlock(hClipData);
         }
+
         CloseClipboard();
     }
-
 }
 
+/*------------------------------------------------------------------------
+ Procedure:     CopyToClipboard ID:1
+ Purpose:       Copies text to the clipboard
+ Input:			Window with the edit control
+ Output:
+ Errors:
+------------------------------------------------------------------------*/
 static void CopyToClipboard(HWND hwnd)
 {
         HWND hwndEdit = (HWND)GetWindowLong(hwndSession,DWL_USER);
         SendMessage(hwndEdit,WM_COPY,0,0);
 }
 
+/*------------------------------------------------------------------------
+ Procedure:     ResetText ID:1
+ Purpose:       Resets the text? I'm not really sure
+ Input:
+ Output:		Always returns 0
+ Errors:
+------------------------------------------------------------------------*/
 int ResetText(void)
 {
         HWND hwndEdit = (HWND) GetWindowLong(hwndSession,DWL_USER);
@@ -495,6 +704,12 @@ int ResetText(void)
  Input:
  Output:
  Errors:
+--------------------------------------------------------------------------
+ Edit History:
+	06 Oct  2003 - Chris Watford watford@uiuc.edu
+		- Removed entries that crashed OCaml
+		- Removed useless entries
+		- Added Save ML and Save Transcript
 ------------------------------------------------------------------------*/
 void HandleCommand(HWND hwnd, WPARAM wParam,LPARAM lParam)
 {
@@ -508,11 +723,11 @@ void HandleCommand(HWND hwnd, WPARAM wParam,LPARAM lParam)
                                 char *buf = SafeMalloc(512);
                                 char *p = strrchr(fname,'.');
                                 if (p && !stricmp(p,".ml")) {
-                                        wsprintf(buf,"#use \"%s\";;",fname);
+                                        wsprintf(buf, "#use \"%s\";;", fname);
                                         AddLineToControl(buf);
                                 }
                                 else if (p && !stricmp(p,".cmo")) {
-                                        wsprintf(buf,"#load \"%s\";;",fname);
+                                        wsprintf(buf, "#load \"%s\";;", fname);
                                         AddLineToControl(buf);
                                 }
                                 free(buf);
@@ -531,22 +746,42 @@ void HandleCommand(HWND hwnd, WPARAM wParam,LPARAM lParam)
                 case IDM_EDITCOPY:
                         CopyToClipboard(hwnd);
                         break;
-                case IDM_SAVE:
+
+				// updated to save a transcript
+                case IDM_SAVEAS:
                         fname = SafeMalloc(512);
                         if (GetSaveName(fname,512)) {
                                 SaveText(fname);
                         }
                         free(fname);
                         break;
+
+				// updated to save an ML file
+				case IDM_SAVE:
+                        fname = SafeMalloc(512);
+                        if (GetSaveMLName(fname,512))
+						{
+                                SaveML(fname);
+                        }
+                        free(fname);
+                        break;
+
+				// updated to work with new history system
                 case IDM_HISTORY:
                         r = CallDlgProc(HistoryDlgProc,IDD_HISTORY);
-                        if (r) {
+
+                        if (r)
+						{
                                 AddLineToControl(GetHistoryLine(r-1));
                         }
                         break;
+
                 case IDM_PRINTSU:
-                        CallPrintSetup();
+						// Removed by Chris Watford
+						// seems to die
+                        // CallPrintSetup();
                         break;
+
                 case IDM_FONT:
                         CallChangeFont(hwndMain);
                         break;
@@ -563,6 +798,8 @@ void HandleCommand(HWND hwnd, WPARAM wParam,LPARAM lParam)
                 case IDM_EDITUNDO:
                         Undo(hwnd);
                         break;
+
+				/* Removed, really not very useful in this IDE
                 case IDM_WINDOWTILE:
                         SendMessage(hwndMDIClient,WM_MDITILE,0,0);
                         break;
@@ -572,6 +809,8 @@ void HandleCommand(HWND hwnd, WPARAM wParam,LPARAM lParam)
                 case IDM_WINDOWICONS:
                         SendMessage(hwndMDIClient,WM_MDIICONARRANGE,0,0);
                         break;
+				*/
+
                 case IDM_EXIT:
                         PostMessage(hwnd,WM_CLOSE,0,0);
                         break;
@@ -589,4 +828,3 @@ void HandleCommand(HWND hwnd, WPARAM wParam,LPARAM lParam)
                         break;
         }
 }
-
diff --git a/win32caml/ocaml.c b/win32caml/ocaml.c
index 1172b2bd8b..0a4e5b4812 100644
--- a/win32caml/ocaml.c
+++ b/win32caml/ocaml.c
@@ -1,4 +1,3 @@
-/***********************************************************************/
 /*                                                                     */
 /*                           Objective Caml                            */
 /*                                                                     */
@@ -10,14 +9,20 @@
 /*                                                                     */
 /***********************************************************************/
 
+/***********************************************************************/
+/* Changes made by Chris Watford to enhance the source editor          */
+/* Began 14 Sept 2003 - watford@uiuc.edu                               */
+/***********************************************************************/
+
 /* $Id$ */
 
 /*@@ Wedit generated application. Written Sat Jun 02 18:22:38 2001
- @@header: D:\lcc\inria\inriares.h
- @@resources: D:\lcc\inria\inria.rc
- Do not edit outside the indicated areas */
-/*<---------------------------------------------------------------------->*/
+@@header: D:\lcc\inria\inriares.h
+@@resources: D:\lcc\inria\inria.rc
+Do not edit outside the indicated areas */
 /*<---------------------------------------------------------------------->*/
+
+#include <stdio.h>
 #include <windows.h>
 #include <windowsx.h>
 #include <commctrl.h>
@@ -26,10 +31,13 @@
 #include <Richedit.h>
 #include "inriares.h"
 #include "inria.h"
+
+#define VK_BACKSPACE    0x108
+
+/*<---------------------------------------------------------------------->*/
 int EditControls = IDEDITCONTROL;
 static WNDPROC lpEProc;
 static char lineBuffer[1024*32];
-int ResetText(void);
 int ReadToLineBuffer(void);
 int AddLineBuffer(void);
 static int busy;
@@ -40,7 +48,11 @@ char OcamlPath[512];
 HBRUSH BackgroundBrush;
 COLORREF BackColor = RGB(255,255,255);
 PROGRAM_PARAMS ProgramParams;
-HISTORYLINE *History;
+StatementHistory *History = NULL;
+StatementHistory *HistoryTail = NULL;
+StatementHistory *historyEntry = NULL;
+EditBuffer *CurrentEditBuffer = NULL; // current edit buffer
+
 /*<----------------- global variables --------------------------------------->*/
 HANDLE hInst;           // Instance handle
 HWND hwndMain;          //Main window handle
@@ -52,765 +64,1472 @@ PROCESS_INFORMATION pi;
 HWND  hWndStatusbar;
 
 /*------------------------------------------------------------------------
- Procedure:     UpdateStatusBar ID:1
- Purpose:       Updates the statusbar control with the appropiate
-                text
- Input:         lpszStatusString: Charactar string that will be shown
-                partNumber: index of the status bar part number.
-                displayFlags: Decoration flags
- Output:        none
- Errors:        none
+Procedure:     UpdateStatusBar ID:1
+Purpose:       Updates the statusbar control with the appropiate
+text
+Input:         lpszStatusString: Charactar string that will be shown
+partNumber: index of the status bar part number.
+displayFlags: Decoration flags
+Output:        none
+Errors:        none
 
 ------------------------------------------------------------------------*/
 void UpdateStatusBar(LPSTR lpszStatusString, WORD partNumber, WORD displayFlags)
 {
-    SendMessage(hWndStatusbar,
-                SB_SETTEXT,
-                partNumber | displayFlags,
-                (LPARAM)lpszStatusString);
+	SendMessage(hWndStatusbar,
+		SB_SETTEXT,
+		partNumber | displayFlags,
+		(LPARAM)lpszStatusString);
 }
 
 
 /*------------------------------------------------------------------------
- Procedure:     MsgMenuSelect ID:1
- Purpose:       Shows in the status bar a descriptive explaation of
-                the purpose of each menu item.The message
-                WM_MENUSELECT is sent when the user starts browsing
-                the menu for each menu item where the mouse passes.
- Input:         Standard windows.
- Output:        The string from the resources string table is shown
- Errors:        If the string is not found nothing will be shown.
+Procedure:     MsgMenuSelect ID:1
+Purpose:       Shows in the status bar a descriptive explaation of
+the purpose of each menu item.The message
+WM_MENUSELECT is sent when the user starts browsing
+the menu for each menu item where the mouse passes.
+Input:         Standard windows.
+Output:        The string from the resources string table is shown
+Errors:        If the string is not found nothing will be shown.
 ------------------------------------------------------------------------*/
 LRESULT MsgMenuSelect(HWND hwnd, UINT uMessage, WPARAM wparam, LPARAM lparam)
 {
-    static char szBuffer[256];
-    UINT   nStringID = 0;
-    UINT   fuFlags = GET_WM_MENUSELECT_FLAGS(wparam, lparam) & 0xffff;
-    UINT   uCmd    = GET_WM_MENUSELECT_CMD(wparam, lparam);
-    HMENU  hMenu   = GET_WM_MENUSELECT_HMENU(wparam, lparam);
-
-    szBuffer[0] = 0;                            // First reset the buffer
-    if (fuFlags == 0xffff && hMenu == NULL)     // Menu has been closed
-        nStringID = 0;
-
-    else if (fuFlags & MFT_SEPARATOR)           // Ignore separators
-        nStringID = 0;
-
-    else if (fuFlags & MF_POPUP)                // Popup menu
-    {
-        if (fuFlags & MF_SYSMENU)               // System menu
-            nStringID = IDS_SYSMENU;
-        else
-            // Get string ID for popup menu from idPopup array.
-            nStringID = 0;
-    }  // for MF_POPUP
-    else                                        // Must be a command item
-        nStringID = uCmd;                       // String ID == Command ID
-
-    // Load the string if we have an ID
-    if (0 != nStringID)
-        LoadString(hInst, nStringID, szBuffer, sizeof(szBuffer));
-    // Finally... send the string to the status bar
-    UpdateStatusBar(szBuffer, 0, 0);
-    return 0;
+	static char szBuffer[256];
+	UINT   nStringID = 0;
+	UINT   fuFlags = GET_WM_MENUSELECT_FLAGS(wparam, lparam) & 0xffff;
+	UINT   uCmd    = GET_WM_MENUSELECT_CMD(wparam, lparam);
+	HMENU  hMenu   = GET_WM_MENUSELECT_HMENU(wparam, lparam);
+
+	szBuffer[0] = 0;                            // First reset the buffer
+	if (fuFlags == 0xffff && hMenu == NULL)     // Menu has been closed
+		nStringID = 0;
+
+	else if (fuFlags & MFT_SEPARATOR)           // Ignore separators
+		nStringID = 0;
+
+	else if (fuFlags & MF_POPUP)                // Popup menu
+	{
+		if (fuFlags & MF_SYSMENU)               // System menu
+			nStringID = IDS_SYSMENU;
+		else
+			// Get string ID for popup menu from idPopup array.
+			nStringID = 0;
+	}  // for MF_POPUP
+	else                                        // Must be a command item
+		nStringID = uCmd;                       // String ID == Command ID
+
+	// Load the string if we have an ID
+	if (0 != nStringID)
+		LoadString(hInst, nStringID, szBuffer, sizeof(szBuffer));
+	// Finally... send the string to the status bar
+	UpdateStatusBar(szBuffer, 0, 0);
+	return 0;
 }
 
 /*------------------------------------------------------------------------
- Procedure:     TimerProc ID:1
- Purpose:       This procedure will be called by windows about 4
-                times a second. It will just send a message to the
-                mdi child window to look at the pipe.
- Input:
- Output:
- Errors:
+Procedure:     TimerProc ID:1
+Purpose:       This procedure will be called by windows about 4
+times a second. It will just send a message to the
+mdi child window to look at the pipe.
+Input:
+Output:
+Errors:
 ------------------------------------------------------------------------*/
 static VOID CALLBACK TimerProc(HWND hwnd, UINT uMsg, UINT idEvent, DWORD dwTime)
 {
-   SendMessage(hwndSession, WM_TIMERTICK, 0, 0);
+	SendMessage(hwndSession, WM_TIMERTICK, 0, 0);
 }
 
 /*------------------------------------------------------------------------
- Procedure:     InitializeStatusBar ID:1
- Purpose:       Initialize the status bar
- Input:         hwndParent: the parent window
-                nrOfParts: The status bar can contain more than one
-                part. What is difficult, is to figure out how this
-                should be drawn. So, for the time being only one is
-                being used...
- Output:        The status bar is created
- Errors:
+Procedure:     InitializeStatusBar ID:1
+Purpose:       Initialize the status bar
+Input:         hwndParent: the parent window
+nrOfParts: The status bar can contain more than one
+part. What is difficult, is to figure out how this
+should be drawn. So, for the time being only one is
+being used...
+Output:        The status bar is created
+Errors:
 ------------------------------------------------------------------------*/
 void InitializeStatusBar(HWND hwndParent,int nrOfParts)
 {
-    const int cSpaceInBetween = 8;
-    int   ptArray[40];   // Array defining the number of parts/sections
-    RECT  rect;
-    HDC   hDC;
+	const int cSpaceInBetween = 8;
+	int   ptArray[40];   // Array defining the number of parts/sections
+	RECT  rect;
+	HDC   hDC;
 
-   /* * Fill in the ptArray...  */
+	/* * Fill in the ptArray...  */
 
-    hDC = GetDC(hwndParent);
-    GetClientRect(hwndParent, &rect);
+	hDC = GetDC(hwndParent);
+	GetClientRect(hwndParent, &rect);
 
-    ptArray[nrOfParts-1] = rect.right;
-    //---TODO--- Add code to calculate the size of each part of the status
-    // bar here.
+	ptArray[nrOfParts-1] = rect.right;
+	//---TODO--- Add code to calculate the size of each part of the status
+	// bar here.
 
-    ReleaseDC(hwndParent, hDC);
-    SendMessage(hWndStatusbar,
-                SB_SETPARTS,
-                nrOfParts,
-                (LPARAM)(LPINT)ptArray);
+	ReleaseDC(hwndParent, hDC);
+	SendMessage(hWndStatusbar,
+		SB_SETPARTS,
+		nrOfParts,
+		(LPARAM)(LPINT)ptArray);
 
-    UpdateStatusBar("Ready", 0, 0);
+	UpdateStatusBar("Ready", 0, 0);
 }
 
 
 /*------------------------------------------------------------------------
- Procedure:     CreateSBar ID:1
- Purpose:       Calls CreateStatusWindow to create the status bar
- Input:         hwndParent: the parent window
-                initial text: the initial contents of the status bar
- Output:
- Errors:
+Procedure:     CreateSBar ID:1
+Purpose:       Calls CreateStatusWindow to create the status bar
+Input:         hwndParent: the parent window
+initial text: the initial contents of the status bar
+Output:
+Errors:
 ------------------------------------------------------------------------*/
 static BOOL CreateSBar(HWND hwndParent,char *initialText,int nrOfParts)
 {
-    hWndStatusbar = CreateStatusWindow(WS_CHILD | WS_VISIBLE | WS_BORDER|SBARS_SIZEGRIP,
-                                       initialText,
-                                       hwndParent,
-                                       IDM_STATUSBAR);
-    if(hWndStatusbar)
-    {
-        InitializeStatusBar(hwndParent,nrOfParts);
-        return TRUE;
-    }
-
-    return FALSE;
+	hWndStatusbar = CreateStatusWindow(WS_CHILD | WS_VISIBLE | WS_BORDER|SBARS_SIZEGRIP,
+		initialText,
+		hwndParent,
+		IDM_STATUSBAR);
+	if(hWndStatusbar)
+	{
+		InitializeStatusBar(hwndParent,nrOfParts);
+		return TRUE;
+	}
+
+	return FALSE;
 }
 /*------------------------------------------------------------------------
- Procedure:     InitApplication ID:1
- Purpose:       Registers two window classes: the "inria" window
-                class with the main window, and the mdi child
-                window's window class.
- Input:
- Output:
- Errors:
+Procedure:     InitApplication ID:1
+Purpose:       Registers two window classes: the "inria" window
+class with the main window, and the mdi child
+window's window class.
+Input:
+Output:
+Errors:
 ------------------------------------------------------------------------*/
 static BOOL InitApplication(void)
 {
-        WNDCLASS wc;
-
-        memset(&wc,0,sizeof(WNDCLASS));
-        wc.style = CS_HREDRAW|CS_VREDRAW |CS_DBLCLKS ;
-        wc.lpfnWndProc = (WNDPROC)MainWndProc;
-        wc.hInstance = hInst;
-        wc.hbrBackground = (HBRUSH)(COLOR_WINDOW+1);
-        wc.lpszClassName = "inriaWndClass";
-        wc.lpszMenuName = MAKEINTRESOURCE(IDMAINMENU);
-        wc.hCursor = LoadCursor(NULL,IDC_ARROW);
-        wc.hIcon = LoadIcon(hInst,MAKEINTRESOURCE(OCAML_ICON));
-        if (!RegisterClass(&wc))
-                return 0;
-        wc.style         = 0;
-        wc.lpfnWndProc   = (WNDPROC)MdiChildWndProc;
-        wc.cbClsExtra    = 0;
-        wc.cbWndExtra    = 20;
-        wc.hInstance     = hInst;                      // Owner of this class
-        wc.hIcon         = LoadIcon(hInst, MAKEINTRESOURCE(OCAML_ICON));
-        wc.hCursor       = LoadCursor(NULL, IDC_ARROW);
-        wc.hbrBackground = (HBRUSH)(COLOR_WINDOW + 1); // Default color
-        wc.lpszMenuName  = NULL;
-        wc.lpszClassName = "MdiChildWndClass";
-        if (!RegisterClass((LPWNDCLASS)&wc))
-                return FALSE;
-        return 1;
+	WNDCLASS wc;
+
+	memset(&wc,0,sizeof(WNDCLASS));
+	wc.style = CS_HREDRAW|CS_VREDRAW |CS_DBLCLKS ;
+	wc.lpfnWndProc = (WNDPROC)MainWndProc;
+	wc.hInstance = hInst;
+	wc.hbrBackground = (HBRUSH)(COLOR_WINDOW+1);
+	wc.lpszClassName = "inriaWndClass";
+	wc.lpszMenuName = MAKEINTRESOURCE(IDMAINMENU);
+	wc.hCursor = LoadCursor(NULL,IDC_ARROW);
+	wc.hIcon = LoadIcon(hInst,MAKEINTRESOURCE(OCAML_ICON));
+	if (!RegisterClass(&wc))
+		return 0;
+	wc.style         = 0;
+	wc.lpfnWndProc   = (WNDPROC)MdiChildWndProc;
+	wc.cbClsExtra    = 0;
+	wc.cbWndExtra    = 20;
+	wc.hInstance     = hInst;                      // Owner of this class
+	wc.hIcon         = LoadIcon(hInst, MAKEINTRESOURCE(OCAML_ICON));
+	wc.hCursor       = LoadCursor(NULL, IDC_ARROW);
+	wc.hbrBackground = (HBRUSH)(COLOR_WINDOW + 1); // Default color
+	wc.lpszMenuName  = NULL;
+	wc.lpszClassName = "MdiChildWndClass";
+	if (!RegisterClass((LPWNDCLASS)&wc))
+		return FALSE;
+	return 1;
 }
 
 /*------------------------------------------------------------------------
- Procedure:     CreateinriaWndClassWnd ID:1
- Purpose:       Creates the main window
- Input:
- Output:
- Errors:
+Procedure:     CreateinriaWndClassWnd ID:1
+Purpose:       Creates the main window
+Input:
+Output:
+Errors:
 ------------------------------------------------------------------------*/
 HWND CreateinriaWndClassWnd(void)
 {
-        return CreateWindow("inriaWndClass","Ocaml",
-                WS_MINIMIZEBOX|WS_VISIBLE|WS_CLIPSIBLINGS|WS_CLIPCHILDREN|WS_MAXIMIZEBOX|WS_CAPTION|WS_BORDER|WS_SYSMENU|WS_THICKFRAME,
-                CW_USEDEFAULT,0,CW_USEDEFAULT,0,
-                NULL,
-                NULL,
-                hInst,
-                NULL);
+	return CreateWindow("inriaWndClass","OCamlWinPlus v1.9RC4",
+		WS_MINIMIZEBOX|WS_VISIBLE|WS_CLIPSIBLINGS|WS_CLIPCHILDREN|WS_MAXIMIZEBOX|WS_CAPTION|WS_BORDER|WS_SYSMENU|WS_THICKFRAME,
+		CW_USEDEFAULT,0,CW_USEDEFAULT,0,
+		NULL,
+		NULL,
+		hInst,
+		NULL);
 }
 
 /*------------------------------------------------------------------------
- Procedure:     MDICmdFileNew ID:1
- Purpose:       Creates a new session window. Note that multiple
-                windows with multiple sessions are possible.
- Input:
- Output:
- Errors:
+Procedure:     MDICmdFileNew ID:1
+Purpose:       Creates a new session window. Note that multiple
+windows with multiple sessions are possible.
+Input:
+Output:
+Errors:
 ------------------------------------------------------------------------*/
 static HWND MDICmdFileNew(char *title, int show)
 {
-        HWND  hwndChild;
-        char  rgch[150];
-        static int cUntitled;
-        MDICREATESTRUCT mcs;
+	HWND  hwndChild;
+	char  rgch[150];
+	static int cUntitled;
+	MDICREATESTRUCT mcs;
+
+	if (title == NULL)
+		wsprintf(rgch,"Session%d", cUntitled++);
+	else {
+		strncpy(rgch,title,149);
+		rgch[149] = 0;
+	}
+
+	// Create the MDI child window
+
+	mcs.szClass = "MdiChildWndClass";      // window class name
+	mcs.szTitle = rgch;             // window title
+	mcs.hOwner  = hInst;            // owner
+	mcs.x       = CW_USEDEFAULT;    // x position
+	mcs.y       = CW_USEDEFAULT;    // y position
+	mcs.cx      = CW_USEDEFAULT;    // width
+	mcs.cy      = CW_USEDEFAULT;    // height
+	mcs.style   = 0;                // window style
+	mcs.lParam  = 0;                // lparam
+
+	hwndChild = (HWND) SendMessage(hwndMDIClient,
+		WM_MDICREATE,
+		0,
+		(LPARAM)(LPMDICREATESTRUCT) &mcs);
+
+	if (hwndChild != NULL && show)
+		ShowWindow(hwndChild, SW_SHOW);
+
+	return hwndChild;
+}
+static HWND CreateMdiClient(HWND hwndparent)
+{
+	CLIENTCREATESTRUCT ccs = {0};
+	HWND hwndMDIClient;
+	int icount = GetMenuItemCount(GetMenu(hwndparent));
+
+	// Find window menu where children will be listed
+	ccs.hWindowMenu  = GetSubMenu(GetMenu(hwndparent), icount-2);
+	ccs.idFirstChild = IDM_WINDOWCHILD;
+
+	// Create the MDI client filling the client area
+	hwndMDIClient = CreateWindow("mdiclient",
+		NULL,
+		WS_CHILD | WS_CLIPCHILDREN | WS_VSCROLL |
+		WS_HSCROLL,
+		0, 0, 0, 0,
+		hwndparent,
+		(HMENU)0xCAC,
+		hInst,
+		(LPVOID)&ccs);
+
+	ShowWindow(hwndMDIClient, SW_SHOW);
+
+	return hwndMDIClient;
+}
 
-        if (title == NULL)
-                wsprintf(rgch,"Session%d", cUntitled++);
-        else {
-                strncpy(rgch,title,149);
-                rgch[149] = 0;
-        }
+void GotoEOF(void)
+{
+	HWND hEdit = (HWND)GetWindowLong(hwndSession,DWL_USER);
+	int linesCount = SendMessage(hEdit,EM_GETLINECOUNT,0,0);
+	int lineindex = SendMessage(hEdit,EM_LINEINDEX,linesCount-1,0);
+	int lastLineLength = SendMessage(hEdit,EM_LINELENGTH,linesCount-1,0);
 
-        // Create the MDI child window
+	lineindex += lastLineLength;
+	SendMessage(hEdit,EM_SETSEL,lineindex,lineindex);
+}
 
-        mcs.szClass = "MdiChildWndClass";      // window class name
-        mcs.szTitle = rgch;             // window title
-        mcs.hOwner  = hInst;            // owner
-        mcs.x       = CW_USEDEFAULT;    // x position
-        mcs.y       = CW_USEDEFAULT;    // y position
-        mcs.cx      = CW_USEDEFAULT;    // width
-        mcs.cy      = CW_USEDEFAULT;    // height
-        mcs.style   = 0;                // window style
-        mcs.lParam  = 0;                // lparam
+/*------------------------------------------------------------------------
+Procedure:     GotoPrompt ID:1
+Author:		   Chris Watford watford@uiuc.edu
+Purpose:       Puts the cursor on the prompt line right after the '# '
+Input:
+Output:
+Errors:
+------------------------------------------------------------------------*/
+void GotoPrompt(void)
+{
+	HWND hEdit = (HWND)GetWindowLong(hwndSession,DWL_USER);
+	int lineindex = SendMessage(hEdit,EM_LINEINDEX,LastPromptPosition.line,0)+2;
+	SendMessage(hEdit,EM_SETSEL,lineindex,lineindex);
+}
 
-        hwndChild = (HWND) SendMessage(hwndMDIClient,
-                                       WM_MDICREATE,
-                                       0,
-                                       (LPARAM)(LPMDICREATESTRUCT) &mcs);
+int GetCurLineIndex(HWND hEdit)
+{
+	return SendMessage(hEdit,EM_LINEFROMCHAR,(WPARAM)-1,0);
+}
 
-        if (hwndChild != NULL && show)
-                ShowWindow(hwndChild, SW_SHOW);
+int GetNumberOfLines(HWND hEdit)
+{
+	return SendMessage(hEdit,EM_GETLINECOUNT,0,0);
+}
 
-        return hwndChild;
+static int GetWordUnderCursor(HWND hwndEditControl,char *buf,int len)
+{
+	char *line,*p,*pstart,*pend;
+	int lineidx,start,end,length,offset,cursorpos,startingChar;
+
+	SendMessage(hwndEditControl,EM_GETSEL,(WPARAM)&start,(LPARAM)&end);
+	lineidx = SendMessage(hwndEditControl,EM_EXLINEFROMCHAR,0,start);
+	startingChar = SendMessage(hwndEditControl,EM_LINEINDEX,lineidx,0);
+	start -= startingChar;
+	end -= startingChar;
+	lineidx = SendMessage(hwndEditControl,EM_LINEFROMCHAR,start,0);
+	length = SendMessage(hwndEditControl,EM_LINELENGTH,lineidx,0);
+	offset = SendMessage(hwndEditControl,EM_LINEINDEX,lineidx,0);
+	line = SafeMalloc(length+1);
+	memset(line,0,length+1);
+	*(unsigned short *)line = length;
+	SendMessage(hwndEditControl,EM_GETLINE,lineidx,(LPARAM)line);
+	cursorpos = start-offset;
+	p = line + cursorpos;
+	pstart = p;
+	while (*pstart
+		&& *pstart != ' '
+		&& *pstart != '\t'
+		&& *pstart != '('
+		&& pstart > line)
+		pstart--;
+	pend = p;
+	while (*pend
+		&& *pend != ' '
+		&& *pend != '\t'
+		&& *pend != '('
+		&& pend < line + length)
+		pend++;
+	if (*pstart == ' ' || *pstart == '\t')
+		pstart++;
+	if (*pend == ' ' || *pend == '\t')
+		pend--;
+	memcpy(buf,pstart,1+pend-pstart);
+	buf[pend-pstart] = 0;
+	free(line);
+	return 1;
 }
-static HWND CreateMdiClient(HWND hwndparent)
+
+/*------------------------------------------------------------------------
+Procedure:     GetLastLine ID:1
+Purpose:       Gets the data in the line containing the cursor to
+			   the interpreter.
+Input:         The edit control window handle
+Output:        None explicit
+Errors:        None
+------------------------------------------------------------------------*/
+char* GetLastLine(HWND hEdit)
 {
-    CLIENTCREATESTRUCT ccs = {0};
-    HWND hwndMDIClient;
-    int icount = GetMenuItemCount(GetMenu(hwndparent));
+	int curline = GetCurLineIndex(hEdit);
+	char *linebuffer = (char*)SafeMalloc(2048*sizeof(char));
+	int n;
+	int linescount = GetNumberOfLines(hEdit);
 
-    // Find window menu where children will be listed
-    ccs.hWindowMenu  = GetSubMenu(GetMenu(hwndparent), icount-2);
-    ccs.idFirstChild = IDM_WINDOWCHILD;
+	*(unsigned short *)linebuffer = 2047;
+	n = SendMessage(hEdit,EM_GETLINE,curline,(LPARAM)linebuffer);
 
-    // Create the MDI client filling the client area
-    hwndMDIClient = CreateWindow("mdiclient",
-                                 NULL,
-                                 WS_CHILD | WS_CLIPCHILDREN | WS_VSCROLL |
-                                 WS_HSCROLL,
-                                 0, 0, 0, 0,
-                                 hwndparent,
-                                 (HMENU)0xCAC,
-                                 hInst,
-                                 (LPVOID)&ccs);
+	if (n >= 2 && linebuffer[0] == '#' && linebuffer[1] == ' ') {
+		n -= 2;
+		memmove(linebuffer, linebuffer+2, n);
+	}
 
-    ShowWindow(hwndMDIClient, SW_SHOW);
+	linebuffer[n] = '\0';
 
-    return hwndMDIClient;
+	return linebuffer;
 }
 
-void GotoEOF(void)
+void DoHelp(HWND hwnd)
 {
-        HWND hEdit = (HWND)GetWindowLong(hwndSession,DWL_USER);
-        int linesCount = SendMessage(hEdit,EM_GETLINECOUNT,0,0);
-        int lineindex = SendMessage(hEdit,EM_LINEINDEX,linesCount-1,0);
-        int lastLineLength = SendMessage(hEdit,EM_LINELENGTH,linesCount-1,0);
-
-        lineindex += lastLineLength;
-        SendMessage(hEdit,EM_SETSEL,lineindex,lineindex);
+	char word[256];
+	GetWordUnderCursor(hwnd,word,sizeof(word));
+	MessageBox(NULL,word,"Aide pour:",MB_OK);
 }
 
-int GetCurLineIndex(HWND hEdit)
+/*------------------------------------------------------------------------
+Procedure:     RewriteCurrentEditBuffer ID:1
+Purpose:       Rewrites what is at the prompt with the current contents of
+			   the edit buffer
+Input:         None
+Output:        None explicit
+Errors:        None
+------------------------------------------------------------------------*/
+void RewriteCurrentEditBuffer(void)
 {
-        return SendMessage(hEdit,EM_LINEFROMCHAR,(WPARAM)-1,0);
+	// get the editbox's handle
+	HWND hEdit = (HWND)GetWindowLong(hwndSession,DWL_USER);
+
+	// calculate what to highlight
+	int linesCount = SendMessage(hEdit,EM_GETLINECOUNT,0,0);
+	int lineindex = SendMessage(hEdit,EM_LINEINDEX,LastPromptPosition.line,0) + 2;
+	int lastLine = SendMessage(hEdit,EM_LINEINDEX,linesCount-1,0) + SendMessage(hEdit,EM_LINELENGTH,linesCount-1,0) + 100;
+
+	// delete the current text
+	SendMessage(hEdit, EM_SETSEL, (WPARAM)lineindex, (LPARAM)lastLine);
+	SendMessage(hEdit, EM_REPLACESEL, (WPARAM)TRUE, (LPARAM)"");
+
+	{
+		// loop through each line in the edit buffer and add it to the control
+		LineList* line = CurrentEditBuffer->Lines;
+		for(; line != NULL; line = line->Next)
+		{
+			// if there is a line before me, add a newline
+			if(line->Prev != NULL)
+				SendMessage(hEdit, EM_REPLACESEL, (WPARAM)TRUE, (LPARAM)"\r\n");
+
+			// add the line
+			SendMessage(hEdit, EM_REPLACESEL, (WPARAM)TRUE, (LPARAM)line->Text);
+		}
+	}
 }
 
-int GetNumberOfLines(HWND hEdit)
+/*------------------------------------------------------------------------
+Procedure:     RefreshCurrentEditBuffer ID:1
+Purpose:       Rewrites what is in the CurrentEditBuffer with what is
+			   actually there
+Input:         None
+Output:        None explicit
+Errors:        None
+------------------------------------------------------------------------*/
+void RefreshCurrentEditBuffer(void)
 {
-        return SendMessage(hEdit,EM_GETLINECOUNT,0,0);
+	// get the editbox's handle
+	HWND hEdit = (HWND)GetWindowLong(hwndSession,DWL_USER);
+
+	// get the last line index
+	int linesCount = SendMessage(hEdit,EM_GETLINECOUNT,0,0) - 1;
+	int i = 0, n = 0;
+
+	// where to hold the line we grab
+	char *linebuffer = (char*)SafeMalloc(2048*sizeof(char));
+	*(unsigned short *)linebuffer = 2047;
+
+	editbuffer_destroy(CurrentEditBuffer);
+	CurrentEditBuffer = editbuffer_new();
+
+	// loop through each line updating or adding it to the current edit buffer
+	for( ; (i + LastPromptPosition.line) <= linesCount; i++)
+	{
+		n = SendMessage(hEdit, EM_GETLINE, (i + LastPromptPosition.line), (LPARAM)linebuffer);
+
+		if ((n >= 2) && (linebuffer[0] == '#') && (linebuffer[1] == ' ')) {
+			n -= 2;
+			memmove(linebuffer, linebuffer+2, n);
+		}
+
+		linebuffer[n] = '\0';
+
+		{	// remove line breaks and feeds
+			char* ln = linebuffer;
+
+			while((*ln) != 0)
+			{
+				switch((*ln))
+				{
+					case '\r':
+					case '\n':
+						(*ln) = ' ';
+				}
+
+				ln++;
+			}
+		}
+
+		editbuffer_addline(CurrentEditBuffer, linebuffer);
+	}
 }
 
-static int GetWordUnderCursor(HWND hwndEditControl,char *buf,int len)
+/*------------------------------------------------------------------------
+Procedure:     NextHistoryEntry ID:1
+Purpose:       Scrolls to the next history entry
+Input:         None
+Output:        None explicit
+Errors:        None
+--------------------------------------------------------------------------
+Edit History:
+	17 Sept 2003 - Chris Watford watford@uiuc.edu
+		- Added this as a helper function
+	18 Sept 2003 - Chris Watford watford@uiuc.edu
+		- Corrected doubly linked list problems
+------------------------------------------------------------------------*/
+void NextHistoryEntry(void)
 {
-    char *line,*p,*pstart,*pend;
-    int lineidx,start,end,length,offset,cursorpos,startingChar;
-
-    SendMessage(hwndEditControl,EM_GETSEL,(WPARAM)&start,(LPARAM)&end);
-    lineidx = SendMessage(hwndEditControl,EM_EXLINEFROMCHAR,0,start);
-    startingChar = SendMessage(hwndEditControl,EM_LINEINDEX,lineidx,0);
-    start -= startingChar;
-    end -= startingChar;
-        lineidx = SendMessage(hwndEditControl,EM_LINEFROMCHAR,start,0);
-    length = SendMessage(hwndEditControl,EM_LINELENGTH,lineidx,0);
-    offset = SendMessage(hwndEditControl,EM_LINEINDEX,lineidx,0);
-    line = SafeMalloc(length+1);
-    memset(line,0,length+1);
-    *(unsigned short *)line = length;
-    SendMessage(hwndEditControl,EM_GETLINE,lineidx,(LPARAM)line);
-    cursorpos = start-offset;
-    p = line + cursorpos;
-    pstart = p;
-    while (*pstart
-            && *pstart != ' '
-            && *pstart != '\t'
-            && *pstart != '('
-            && pstart > line)
-            pstart--;
-    pend = p;
-    while (*pend
-            && *pend != ' '
-            && *pend != '\t'
-            && *pend != '('
-            && pend < line + length)
-            pend++;
-    if (*pstart == ' ' || *pstart == '\t')
-            pstart++;
-    if (*pend == ' ' || *pend == '\t')
-            pend--;
-    memcpy(buf,pstart,1+pend-pstart);
-    buf[pend-pstart] = 0;
-        free(line);
-    return 1;
+	// out of bounds, put it back into bounds
+	if(historyEntry == NULL && History == NULL)
+	{
+		return;
+	} else if (historyEntry == NULL && History != NULL) {
+		historyEntry = History;
+	} else {
+		if(historyEntry->Next == NULL)
+			return;
+
+		historyEntry = historyEntry->Next;
+	}
+
+	// if its valid
+	if(historyEntry != NULL)
+	{
+		// copy the history entry to a new buffer
+		EditBuffer* newBuf = editbuffer_copy(historyEntry->Statement);
+
+		// destroy the old buffer
+		editbuffer_destroy(CurrentEditBuffer);
+
+		// setup the current one to the copy
+		CurrentEditBuffer = newBuf;
+
+		// rewrite the old one and go to the prompt
+		RewriteCurrentEditBuffer();
+		GotoPrompt();
+	}
 }
 
-void DoHelp(HWND hwnd)
+/*------------------------------------------------------------------------
+Procedure:     PrevHistoryEntry ID:1
+Purpose:       Scrolls to the previous history entry
+Input:         None
+Output:        None explicit
+Errors:        None
+--------------------------------------------------------------------------
+Edit History:
+	17 Sept 2003 - Chris Watford watford@uiuc.edu
+		- Added this as a helper function
+	18 Sept 2003 - Chris Watford watford@uiuc.edu
+		- Corrected doubly linked list problems
+------------------------------------------------------------------------*/
+void PrevHistoryEntry(void)
 {
-    char word[256];
-    GetWordUnderCursor(hwnd,word,sizeof(word));
-        MessageBox(NULL,word,"Aide pour:",MB_OK);
+	// out of bounds, put it back into bounds
+	if(historyEntry == NULL || History == NULL)
+	{
+		return;
+	} else {
+		if(historyEntry->Prev == NULL)
+			return;
+
+		historyEntry = historyEntry->Prev;
+	}
+
+	// if its valid
+	if(historyEntry != NULL)
+	{
+		// copy the history entry to a new buffer
+		EditBuffer* newBuf = editbuffer_copy(historyEntry->Statement);
+
+		// destroy the old buffer
+		editbuffer_destroy(CurrentEditBuffer);
+
+		// setup the current one to the copy
+		CurrentEditBuffer = newBuf;
+
+		// rewrite the old one and go to the prompt
+		RewriteCurrentEditBuffer();
+		GotoPrompt();
+	}
 }
 
-
+/*------------------------------------------------------------------------
+Procedure:     SubClassEdit ID:1
+Purpose:       Handles messages to the editbox
+Input:         
+Output:        
+Errors:
+--------------------------------------------------------------------------
+Edit History:
+	14 Sept 2003 - Chris Watford watford@uiuc.edu
+		- Setup handler for up and down arrows
+	15 Sept 2003 - Chris Watford watford@uiuc.edu
+		- Setup framework for history on up arrow
+		- Saves lines you move off of in the edit buffer
+	16 Sept 2003 - Chris Watford watford@uiuc.edu
+		- Proper handling of newline message finished
+		- Fixed ENTER on middle of interior line, moves cursor to the end
+		  and sends the line
+		- Setup the copying and destroying of the old buffer
+		- Included buffer rewrite
+	17 Sept 2003 - Chris Watford watford@uiuc.edu
+		- Added C-p/C-n support
+		- Changed UpArrow to C-UpArrow so as to not confuse users
+	18 Sept 2003 - Chris Watford watford@uiuc.edu
+		- Added Left and Right arrow line saving
+		- Added backspace and delete line saving and removing
+		- Fixed history scrolling
+	21 Sept 2003 - Chris Watford watford@uiuc.edu
+		- Fixed pasting errors associated with lines being out of bounds
+		  for the buffer
+		- Added error handling, possibly able to handle it diff down the
+		  line
+		- Removed C-Up/C-Dn for history scrolling, buggy at best on my
+		  machine
+------------------------------------------------------------------------*/
 static LRESULT CALLBACK SubClassEdit(HWND hwnd, UINT msg, WPARAM mp1, LPARAM mp2)
 {
-        LRESULT r;
-        int postit=0,nl;
-        if (msg == WM_CHAR && mp1 == '\r') {
-                if (!busy) {
-                        CallWindowProc(lpEProc,hwnd,WM_KEYDOWN,VK_END,1);
-                        CallWindowProc(lpEProc,hwnd,WM_KEYUP,VK_END,1);
-                        r =  GetCurLineIndex(hwnd);
-                        nl = GetNumberOfLines(hwnd);
-                        if (r != nl-1) {
-                                PostMessage(GetParent(hwnd),WM_NEWLINE,0,0);
-                                return 0;
-                        }
-                        postit = 1;
-                }
-
-        }
-        else if (msg == WM_KEYDOWN && mp1 == VK_F1) {
-                DoHelp(hwnd);
-        }
-        r = CallWindowProc(lpEProc, hwnd, msg, mp1, mp2);
-        if (postit)
-                PostMessage(GetParent(hwnd),WM_NEWLINE,0,0);
-        return r;
+	LRESULT r;
+	int postit=0,nl;
+
+	if (msg == WM_CHAR && mp1 == '\r') {
+		if (!busy) {
+			r =  GetCurLineIndex(hwnd);
+			nl = GetNumberOfLines(hwnd);
+
+			// if we're not the last line
+			if (r != nl-1)
+			{
+				// update or add us, we might not have any lines in the edit buffer
+				editbuffer_updateoraddline(CurrentEditBuffer, r-LastPromptPosition.line, GetLastLine(hwnd));
+
+				// scroll to the end, add CrLf then post the newline message
+				GotoEOF();
+				AddStringToControl("\r\n");
+				PostMessage(GetParent(hwnd),WM_NEWLINE,0,0);
+				return 0;
+			}
+
+			CallWindowProc(lpEProc,hwnd,WM_KEYDOWN,VK_END,1);
+			CallWindowProc(lpEProc,hwnd,WM_KEYUP,VK_END,1);
+
+			postit = 1;
+		}
+
+	}
+	else if (msg == WM_CHAR && mp1 == (char)0x08) {
+		int lineindex = SendMessage(hwnd, EM_LINEINDEX, LastPromptPosition.line, 0) + 2;
+		int curline = SendMessage(hwnd,EM_LINEFROMCHAR,(WPARAM)-1,0);
+		int nextline = 0;
+		int curpoint = 0;
+
+		SendMessage(hwnd, EM_GETSEL, (WPARAM)&curpoint, (LPARAM)NULL); 
+		nextline = SendMessage(hwnd,EM_LINEFROMCHAR,(WPARAM)(curpoint - 1),0);
+
+		if(curpoint <= lineindex)
+		{
+			return 0;
+		} else if(nextline != curline) {
+			// delete the line we're on
+
+			// grab the index
+			curline -= LastPromptPosition.line;
+
+			// kill it
+			editbuffer_removeline(CurrentEditBuffer, curline);
+		}
+	}
+	else if (msg == WM_KEYDOWN && mp1 == VK_F1) {
+		DoHelp(hwnd);
+	}
+	else if ((msg == WM_KEYDOWN || msg == WM_KEYUP) && mp1 == VK_UP) {
+		int curline = GetCurLineIndex(hwnd);
+
+		/*if((msg == WM_KEYDOWN) && (GetKeyState(VK_CONTROL) && 0x8000))
+		{	// go forward once in history
+			NextHistoryEntry();
+			return 0;
+		} else */
+		if((curline > LastPromptPosition.line) && (curline <= (LastPromptPosition.line + CurrentEditBuffer->LineCount)))
+		{
+			// update current line
+			if (msg == WM_KEYDOWN)
+			{
+				int lineidx = (curline - LastPromptPosition.line);
+
+				CallWindowProc(lpEProc,hwnd,WM_KEYDOWN,VK_END,1);
+				CallWindowProc(lpEProc,hwnd,WM_KEYUP,VK_END,1);
+				
+				// we may have to add this line, otherwise update it
+				editbuffer_updateoraddline(CurrentEditBuffer, lineidx, GetLastLine(hwnd));
+			}
+		} else {
+			return 0;
+		}
+	}
+	else if ((msg == WM_KEYDOWN || msg == WM_KEYUP) && (mp1 == VK_LEFT)) {
+		int lineindex = SendMessage(hwnd, EM_LINEINDEX, LastPromptPosition.line, 0) + 2;
+		int curline = SendMessage(hwnd,EM_LINEFROMCHAR,(WPARAM)-1,0);
+		int nextline = 0;
+		int curpoint = 0;
+
+		SendMessage(hwnd, EM_GETSEL, (WPARAM)&curpoint, (LPARAM)NULL); 
+		nextline = SendMessage(hwnd,EM_LINEFROMCHAR,(WPARAM)(curpoint - 1),0);
+
+		if(curpoint <= lineindex)
+		{	// no left arrow to the left of the prompt
+			return 0;
+		} else if(nextline != curline) {
+			// update current line
+			if (msg == WM_KEYDOWN)
+			{
+				int lineidx = (curline - LastPromptPosition.line);
+
+				CallWindowProc(lpEProc,hwnd,WM_KEYDOWN,VK_END,1);
+				CallWindowProc(lpEProc,hwnd,WM_KEYUP,VK_END,1);
+				
+				// we may have to add this line, otherwise update it
+				editbuffer_updateoraddline(CurrentEditBuffer, lineidx, GetLastLine(hwnd));
+
+				CallWindowProc(lpEProc,hwnd,WM_KEYDOWN,VK_HOME,1);
+				CallWindowProc(lpEProc,hwnd,WM_KEYUP,VK_HOME,1);
+			}
+		}
+	}
+	else if ((msg == WM_KEYDOWN || msg == WM_KEYUP) && (mp1 == VK_DOWN)) {
+		int curline = GetCurLineIndex(hwnd);
+		
+		/*if((msg == WM_KEYDOWN) && (GetKeyState(VK_CONTROL) && 0x8000))
+		{	// go back once in history
+			PrevHistoryEntry();
+			return 0;
+		} else*/
+		if((curline >= LastPromptPosition.line) && (curline < (LastPromptPosition.line + CurrentEditBuffer->LineCount)))
+		{
+			// We don't post the newline, but instead update the current line
+			if (msg == WM_KEYDOWN)
+			{
+				int lineidx = (curline - LastPromptPosition.line);
+
+				CallWindowProc(lpEProc,hwnd,WM_KEYDOWN,VK_END,1);
+				CallWindowProc(lpEProc,hwnd,WM_KEYUP,VK_END,1);
+				
+				editbuffer_updateline(CurrentEditBuffer, lineidx, GetLastLine(hwnd));
+			}
+		} else {
+			return 0;
+		}
+	}
+	else if ((msg == WM_KEYDOWN || msg == WM_KEYUP) && (mp1 == VK_RIGHT)) {
+		int lineindex = SendMessage(hwnd, EM_LINEINDEX, LastPromptPosition.line, 0) + 1;
+		int curline = SendMessage(hwnd,EM_LINEFROMCHAR,(WPARAM)-1,0);
+		int nextline = 0;
+		int curpoint = 0;
+
+		SendMessage(hwnd, EM_GETSEL, (WPARAM)&curpoint, (LPARAM)NULL); 
+		nextline = SendMessage(hwnd,EM_LINEFROMCHAR,(WPARAM)(curpoint + 2),0);
+
+		if(curpoint <= lineindex)
+		{	// no movement behind the prompt
+			return 0;
+		} else if((nextline != curline) && (msg = WM_KEYDOWN)) {
+			int lineidx = (curline - LastPromptPosition.line);
+
+			CallWindowProc(lpEProc,hwnd,WM_KEYDOWN,VK_END,1);
+			CallWindowProc(lpEProc,hwnd,WM_KEYUP,VK_END,1);
+			
+			editbuffer_updateline(CurrentEditBuffer, lineidx, GetLastLine(hwnd));
+		}
+	}
+	else if ((msg == WM_KEYDOWN) && (mp1 == VK_PRIOR) && (GetKeyState(VK_CONTROL) && 0x8000)) {
+		// C-p
+		NextHistoryEntry();
+		return 0;
+	}
+	else if ((msg == WM_KEYDOWN) && (mp1 == VK_NEXT) && (GetKeyState(VK_CONTROL) && 0x8000)) {
+		// C-n
+		PrevHistoryEntry();
+		return 0;
+	}
+	else if ((msg == WM_KEYDOWN || msg == WM_KEYUP) && (mp1 == VK_DELETE)) {
+		// see if we're the last char on the line, if so delete the next line
+		// don't allow deleting left of the prompt
+		int lineindex = SendMessage(hwnd, EM_LINEINDEX, LastPromptPosition.line, 0) + 2;
+		int curline = SendMessage(hwnd,EM_LINEFROMCHAR,(WPARAM)-1,0);
+		int nextline = 0;
+		int curpoint = 0;
+
+		SendMessage(hwnd, EM_GETSEL, (WPARAM)&curpoint, (LPARAM)NULL); 
+		nextline = SendMessage(hwnd,EM_LINEFROMCHAR,(WPARAM)(curpoint + 2),0);
+
+		if(curpoint < lineindex)
+		{	// no chomping behind the prompt
+			return 0;
+		} else if(nextline != curline) {
+			// deleting
+			// grab the next line index
+			curline -= LastPromptPosition.line;
+
+			// kill it
+			editbuffer_removeline(CurrentEditBuffer, curline+1);
+		}
+	}
+	else if (msg == WM_PASTE) {
+		// if they paste text, allow it
+		r = CallWindowProc(lpEProc, hwnd, msg, mp1, mp2);
+
+		// update the current edit buffer
+		RefreshCurrentEditBuffer();
+
+		return r;
+	}
+
+	// handle errors
+	switch(msg)
+	{
+		case WM_SYNTAXERROR:
+		case WM_ILLEGALCHAR:
+		case WM_UNBOUNDVAL:
+			{	// currently I handle them all the same
+				// get the start of the line
+				int start = SendMessage(hwnd, EM_LINEINDEX, LastPromptPosition.line, 0) + 2;
+
+				// get the statement that error'd
+				NextHistoryEntry();
+
+				// tell the history that the last line errored
+				if(History != NULL)
+					if(History->Statement != NULL)
+						History->Statement->isCorrect = FALSE;
+
+				// highlight the offending chars
+				SendMessage(hwnd,EM_SETSEL,(WPARAM)(start + mp1), (LPARAM)(start + mp2));
+				
+				return 0;
+			}
+	}
+
+	r = CallWindowProc(lpEProc, hwnd, msg, mp1, mp2);
+
+	if (postit)
+		PostMessage(GetParent(hwnd),WM_NEWLINE,0,0);
+
+	return r;
 }
 
 static void SubClassEditField(HWND hwnd)
 {
-        if (lpEProc == NULL) {
-                lpEProc = (WNDPROC) GetWindowLong(hwnd, GWL_WNDPROC);
-        }
-        SetWindowLong(hwnd, GWL_WNDPROC, (DWORD) SubClassEdit);
+	if (lpEProc == NULL) {
+		lpEProc = (WNDPROC) GetWindowLong(hwnd, GWL_WNDPROC);
+	}
+	SetWindowLong(hwnd, GWL_WNDPROC, (DWORD) SubClassEdit);
 }
 
-void AddToHistory(char *text)
+/*------------------------------------------------------------------------
+Procedure:     SendLastLine ID:1
+Purpose:       Sends the data in the line containing the cursor to
+the interpreter. If this is NOT the last line, copy
+the line to the end of the text.
+Input:         The edit control window handle
+Output:        None explicit
+Errors:        None
+
+REMOVED!
+------------------------------------------------------------------------*/
+void SendLastLine(HWND hEdit)
 {
-        HISTORYLINE *newLine;
-
-        while (*text == ' ')
-                text++; // skip leading blanks
-        if (*text == 0)
-                return;
-        if (History && !strstr(History->Text,";;")) {
-                char *p = History->Text;
-                int len = strlen(p)+strlen(text) + 1 + 1; // space and zero terminator
-                History->Text = SafeMalloc(len);
-                strcpy(History->Text,p);
-                strcat(History->Text," ");
-                strcat(History->Text,text);
-                free(p);
-                return;
-        }
-        newLine = SafeMalloc(sizeof(HISTORYLINE));
-        newLine->Next = History;
-        newLine->Text = SafeMalloc(strlen(text)+1);
-        strcpy(newLine->Text,text);
-        History = newLine;
+/*	int curline = GetCurLineIndex(hEdit);
+	char *p,linebuffer[2048];
+	int n;
+	int linescount = GetNumberOfLines(hEdit);
+
+	*(unsigned short *)linebuffer = sizeof(linebuffer)-1;
+	if (curline != linescount-1)
+		n = SendMessage(hEdit,EM_GETLINE,curline,(LPARAM)linebuffer);
+	else
+		n = SendMessage(hEdit,EM_GETLINE,curline-1,(LPARAM)linebuffer);
+	if (n >= 2 && linebuffer[0] == '#' && linebuffer[1] == ' ') {
+		n -= 2;
+		memmove(linebuffer, linebuffer+2, n);
+	}
+	linebuffer[n] = 0;
+
+	// Record user input!
+	AddToHistory(linebuffer);
+	linebuffer[n] = '\n';
+	linebuffer[n+1] = 0;
+	WriteToPipe(linebuffer);
+	if (curline != linescount-1) {
+		// Copy the line sent to the end of the text
+		p = strrchr(linebuffer,'\n');
+		if (p) {
+			*p = 0;
+		}
+		busy = 1;
+		AddLineToControl(linebuffer);
+		busy = 0;
+	}*/
 }
 
-char *GetHistoryLine(int n)
+/*------------------------------------------------------------------------
+Procedure:     SendLastEditBuffer ID:1
+Author:		   Chris Watford watford@uiuc.edu
+Purpose:       Sends an edit buffer to the pipe
+Input:
+Output:
+Errors:
+--------------------------------------------------------------------------
+Edit History:
+	15 Sept 2003 - Chris Watford watford@uiuc.edu
+		- Sends line to the pipe and adds newline to the end
+------------------------------------------------------------------------*/
+void SendLastEditBuffer(HWND hwndChild)
 {
-        HISTORYLINE *rvp = History;
-        int i;
+	char* line = editbuffer_getasbuffer(CurrentEditBuffer);
+	int l = strlen(line);
+	char* linebuffer = (char*)SafeMalloc(l+2);
+
+	// save current edit buffer to history and create a new blank edit buffer
+	CurrentEditBuffer->isCorrect = TRUE;
+	AddToHistory(CurrentEditBuffer);
+	CurrentEditBuffer = (EditBuffer*)SafeMalloc(sizeof(EditBuffer));
+	CurrentEditBuffer->LineCount = 0;
+	CurrentEditBuffer->Lines = NULL;
+
+	// add the newline to the end
+	strncpy(linebuffer, line, l);
+	linebuffer[l] = '\n';
+	linebuffer[l+1] = '\0';
+
+	// save line to the pipe
+	WriteToPipe(linebuffer);
+}
 
-        for (i=0; i<n; i++) {
-                rvp = rvp->Next;
-        }
-        if (rvp)
-                return &rvp->Text[0];
-        else
-                return "";
+/*------------------------------------------------------------------------
+Procedure:     SendingFullCommand ID:1
+Author:		   Chris Watford watford@uiuc.edu
+Purpose:       Returns if the command being sent 
+Input:         The edit control window handle
+Output:        None explicit
+Errors:        None
+--------------------------------------------------------------------------
+Edit History:
+	13 Oct  2003 - Chris Watford watford@uiuc.edu
+		- Solved the error when you have a malformed comment in the buffer
+------------------------------------------------------------------------*/
+BOOL SendingFullCommand(void)
+{
+	// if there is a ;; on the line, return true
+	char *line = editbuffer_getasline(CurrentEditBuffer);
+	char *firstComment = strstr(line, "(*"), *firstSemiColonSemiColon = strstr(line, ";;");
+
+	// easy case :D
+	if(firstSemiColonSemiColon == NULL)
+	{
+		free(line);
+		return FALSE;
+	}
+
+	// if there are no comments
+	if(firstComment == NULL)
+	{
+		BOOL r = (firstSemiColonSemiColon != NULL);
+		free(line);
+		return r;
+	} else {
+		// we have to search through finding all comments
+
+		// a neat little trick we can do is compare the point at which
+		// the ;; is and where the first (* can be found, if the ;; is
+		// before the (* ocaml.exe ignores the comment
+		if((unsigned int)firstSemiColonSemiColon < (unsigned int)firstComment)
+		{
+			free(line);
+			return TRUE;
+		} else {
+			// time to search and find if the endline is inside a comment or not
+			// start at the first comment, and move forward keeping track of the
+			// nesting level, if the nest level is 0, i.e. outside a comment
+			// and we find the ;; return TRUE immediately, otherwise keep searching
+			// if we end with a nest level >0 return FALSE
+
+			char *c = firstComment+2; // firstComment[0] is the '(', firstComment[1] is the '*'
+			int nestLevel = 1; // we have a (*
+
+			// in-comment determiner loop
+			while(c[0] != '\0')
+			{
+				// are we an endline
+				if((c[0] == ';') && (c[1] == ';'))
+				{
+					// if we are NOT in a comment, its a full line
+					if(nestLevel <= 0)
+					{
+						free(line);
+						return TRUE;
+					}
+				}
+
+				// are we in a comment?
+				if((c[0] == '(') && (c[1] == '*'))
+				{
+					nestLevel++;
+
+					// watch out we may go past the end
+					if(c[2] == '\0')
+					{
+						free(line);
+						return FALSE;
+					}
+
+					// c needs to advance past the *, cause (*) is NOT the start/finish of a comment
+					c++;
+				}
+
+				// adjust the nesting down a level
+				if((c[0] == '*') && (c[1] == ')'))
+					nestLevel--;
+
+				// next char
+				c++;
+			}
+
+			// not a full line
+			free(line);
+			return FALSE;
+		}
+	}
+
+	// weird case ;)
+	free(line);
+	return FALSE;
 }
 
 /*------------------------------------------------------------------------
- Procedure:     SendLastLine ID:1
- Purpose:       Sends the data in the line containing the cursor to
-                the interpreter. If this is NOT the last line, copy
-                the line to the end of the text.
- Input:         The edit control window handle
- Output:        None explicit
- Errors:        None
+Procedure:     AppendToEditBuffer ID:1
+Author:		   Chris Watford watford@uiuc.edu
+Purpose:       Add a line to the edit buffer
+Input:		   Handle of the edit control
+Output:
+Errors:
 ------------------------------------------------------------------------*/
-void SendLastLine(HWND hEdit)
+void AppendToEditBuffer(HWND hEdit)
 {
-        int curline = GetCurLineIndex(hEdit);
-        char *p,linebuffer[2048];
-        int n;
-        int linescount = GetNumberOfLines(hEdit);
-
-        *(unsigned short *)linebuffer = sizeof(linebuffer)-1;
-        if (curline != linescount-1)
-          n = SendMessage(hEdit,EM_GETLINE,curline,(LPARAM)linebuffer);
-        else
-          n = SendMessage(hEdit,EM_GETLINE,curline-1,(LPARAM)linebuffer);
-        if (n >= 2 && linebuffer[0] == '#' && linebuffer[1] == ' ') {
-          n -= 2;
-          memmove(linebuffer, linebuffer+2, n);
-        }
-        linebuffer[n] = 0;
-        // Record user input!
-        AddToHistory(linebuffer);
-        linebuffer[n] = '\n';
-        linebuffer[n+1] = 0;
-        WriteToPipe(linebuffer);
-        if (curline != linescount-1) {
-                // Copy the line sent to the end of the text
-                p = strrchr(linebuffer,'\n');
-                if (p) {
-                        *p = 0;
-                }
-                busy = 1;
-                AddLineToControl(linebuffer);
-                busy = 0;
-        }
+	char *p = NULL, linebuffer[2048];
+	int n = 0;
+	int curline = GetCurLineIndex(hEdit);
+	int linescount = GetNumberOfLines(hEdit);
+
+	// they are passing the size of the buffer as
+	// the first 'short' in the array...
+	*(unsigned short *)linebuffer = sizeof(linebuffer)-1;
+
+	if (curline > (linescount-1))
+	{
+		n = SendMessage(hEdit, EM_GETLINE, curline, (LPARAM)linebuffer);
+	} else {
+		n = SendMessage(hEdit, EM_GETLINE, --curline, (LPARAM)linebuffer);
+	}
+
+	// correct for the prompt line
+	if (n >= 2 && linebuffer[0] == '#' && linebuffer[1] == ' ')
+	{
+		n -= 2;
+		memmove(linebuffer, linebuffer+2, n);
+	}
+
+	linebuffer[n] = '\0';
+
+	// linebuffer now has the line to add to our edit buffer
+	editbuffer_updateoraddline(CurrentEditBuffer, (curline - LastPromptPosition.line), linebuffer);
 }
+
 /*------------------------------------------------------------------------
- Procedure:     SetLastPrompt ID:1
- Purpose:       Record the position of the last prompt ("# ") sent by
-                the interpreter. This isn't really used yet.
- Input:
- Output:
- Errors:
+Procedure:     SetLastPrompt ID:1
+Purpose:       Record the position of the last prompt ("# ") sent by
+the interpreter. This isn't really used yet.
+Input:
+Output:
+Errors:
 ------------------------------------------------------------------------*/
 void SetLastPrompt(HWND hEdit)
 {
-        DWORD startpos,endpos;
-        SendMessage(hEdit,EM_GETSEL,(WPARAM)&startpos,(LPARAM)&endpos);
-        LastPromptPosition.line = SendMessage(hEdit,EM_LINEFROMCHAR,(WPARAM)-1,0);
-        LastPromptPosition.col = startpos;
+	DWORD startpos,endpos;
+	SendMessage(hEdit,EM_GETSEL,(WPARAM)&startpos,(LPARAM)&endpos);
+	LastPromptPosition.line = SendMessage(hEdit,EM_LINEFROMCHAR,(WPARAM)-1,0);
+	LastPromptPosition.col = startpos;
 }
 
 /*------------------------------------------------------------------------
- Procedure:     MdiChildWndProc ID:1
- Purpose:       The edit control is enclosed in a normal MDI window.
-                This is the window procedure for that window. When it
-                receives the WM_CREATE message, it will create the
-                edit control.
- Input:
- Output:
- Errors:
+Procedure:     MdiChildWndProc ID:1
+Purpose:       The edit control is enclosed in a normal MDI window.
+This is the window procedure for that window. When it
+receives the WM_CREATE message, it will create the
+edit control.
+Input:
+Output:
+Errors:
+--------------------------------------------------------------------------
+Edit History:
+	14 Sept 2003 - Chris Watford watford@uiuc.edu
+		- Added edit buffer and statement buffer support to the WM_NEWLINE
+		  message.
+	15 Sept 2003 - Chris Watford watford@uiuc.edu
+		- Got it adding to the edit buffer
+	16 Sept 2003 - Chris Watford watford@uiuc.edu
+		- Proper handling of newline message finished
+	21 Sept 2003 - Chris Watford watford@uiuc.edu
+		- Added error detection on return from ocaml interp
+	23 Sept 2003 - Chris Watford watford@uiuc.edu
+		- Fixed prompt detection error as pointed out by Patrick Meredith
 ------------------------------------------------------------------------*/
 static LRESULT CALLBACK MdiChildWndProc(HWND hwnd,UINT msg,WPARAM wparam,LPARAM lparam)
 {
-        HWND hwndChild;
-        RECT rc;
-        HDC hDC;
-
-        switch(msg) {
-        case WM_CREATE:
-          GetClientRect(hwnd,&rc);
-          hwndChild= CreateWindow("EDIT",
-                                  NULL,
-                                  WS_CHILD | WS_VISIBLE |
-                                  ES_MULTILINE |
-                                  WS_VSCROLL | WS_HSCROLL |
-                                  ES_AUTOHSCROLL | ES_AUTOVSCROLL,
-                                  0,
-                                  0,
-                                  (rc.right-rc.left),
-                                  (rc.bottom-rc.top),
-                                  hwnd,
-                                  (HMENU) EditControls++,
-                                  hInst,
-                                  NULL);
-          SetWindowLong(hwnd, DWL_USER, (DWORD) hwndChild);
-          SendMessage(hwndChild, WM_SETFONT, (WPARAM) ProgramParams.hFont, 0L);
-          SendMessage(hwndChild,EM_LIMITTEXT,0xffffffff,0);
-          SubClassEditField(hwndChild);
-          break;
-          // Resize the edit control
-        case WM_SIZE:
-          hwndChild = (HWND) GetWindowLong(hwnd, DWL_USER);
-          MoveWindow(hwndChild, 0, 0, LOWORD(lparam), HIWORD(lparam), TRUE);
-          break;
-          // Always set the focus to the edit control.
-        case WM_SETFOCUS:
-          hwndChild = (HWND) GetWindowLong(hwnd, DWL_USER);
-          SetFocus(hwndChild);
-          break;
-          // Repainting of the edit control about to happen.
-          // Set the text color and the background color
-        case WM_CTLCOLOREDIT:
-          hDC = (HDC)wparam;
-          SetTextColor(hDC,ProgramParams.TextColor);
-          SetBkColor(hDC,BackColor);
-          return (LRESULT)BackgroundBrush;
-          // Take care of erasing the background color to avoid flicker
-        case WM_ERASEBKGND:
-          GetWindowRect(hwnd,&rc);
-          hDC = (HDC)wparam;
-          FillRect(hDC,&rc,BackgroundBrush);
-          return 1;
-          // A carriage return has been pressed. Send the data to the interpreted.
-          // This message is posted by the subclassed edit field.
-        case WM_COMMAND:
-          if (LOWORD(wparam) >= IDEDITCONTROL && LOWORD(wparam) < IDEDITCONTROL+5) {
-            switch (HIWORD(wparam)) {
-            case EN_ERRSPACE:
-            case EN_MAXTEXT:
-              ResetText();
-              break;
-            }
-          }
-          break;
-        case WM_NEWLINE:
-          if (busy)
-            break;
-          hwndChild = (HWND) GetWindowLong(hwnd, DWL_USER);
-          SendLastLine(hwndChild);
-          break;
-          // The timer will call us 4 times a second. Look if the interpreter
-          // has written something in its end of the pipe.
-        case WM_TIMERTICK:
-          hwndChild = (HWND) GetWindowLong(hwnd, DWL_USER);
-          if (ReadToLineBuffer()) {
-            char *p;
-                                // Ok we read something. Display it.
-            AddLineBuffer();
-            p = strrchr(lineBuffer,'\r');
-            if (p && !strcmp(p,"\r\n# ")) {
-              if (p[4] == 0) {
-                SetLastPrompt(hwndChild);
-              }
-            }
-
-          }
-          break;
-
-        }
-        return DefMDIChildProc(hwnd, msg, wparam, lparam);
+	HWND hwndChild;
+	RECT rc;
+	HDC hDC;
+
+	switch(msg) {
+		case WM_CREATE:
+			GetClientRect(hwnd,&rc);
+			hwndChild= CreateWindow("EDIT",
+				NULL,
+				WS_CHILD | WS_VISIBLE |
+				ES_MULTILINE |
+				WS_VSCROLL | WS_HSCROLL |
+				ES_AUTOHSCROLL | ES_AUTOVSCROLL,
+				0,
+				0,
+				(rc.right-rc.left),
+				(rc.bottom-rc.top),
+				hwnd,
+				(HMENU) EditControls++,
+				hInst,
+				NULL);
+			SetWindowLong(hwnd, DWL_USER, (DWORD) hwndChild);
+			SendMessage(hwndChild, WM_SETFONT, (WPARAM) ProgramParams.hFont, 0L);
+			SendMessage(hwndChild,EM_LIMITTEXT,0xffffffff,0);
+			SubClassEditField(hwndChild);
+			break;
+			// Resize the edit control
+		case WM_SIZE:
+			hwndChild = (HWND) GetWindowLong(hwnd, DWL_USER);
+			MoveWindow(hwndChild, 0, 0, LOWORD(lparam), HIWORD(lparam), TRUE);
+			break;
+			// Always set the focus to the edit control.
+		case WM_SETFOCUS:
+			hwndChild = (HWND) GetWindowLong(hwnd, DWL_USER);
+			SetFocus(hwndChild);
+			break;
+			// Repainting of the edit control about to happen.
+			// Set the text color and the background color
+		case WM_CTLCOLOREDIT:
+			hDC = (HDC)wparam;
+			SetTextColor(hDC,ProgramParams.TextColor);
+			SetBkColor(hDC,BackColor);
+			return (LRESULT)BackgroundBrush;
+			// Take care of erasing the background color to avoid flicker
+		case WM_ERASEBKGND:
+			GetWindowRect(hwnd,&rc);
+			hDC = (HDC)wparam;
+			FillRect(hDC,&rc,BackgroundBrush);
+			return 1;
+			// A carriage return has been pressed. Send the data to the interpreted.
+			// This message is posted by the subclassed edit field.
+		case WM_COMMAND:
+			if (LOWORD(wparam) >= IDEDITCONTROL && LOWORD(wparam) < IDEDITCONTROL+5) {
+				switch (HIWORD(wparam)) {
+					case EN_ERRSPACE:
+					case EN_MAXTEXT:
+						ResetText();
+						break;
+				}
+			}
+			break;
+		case WM_NEWLINE:
+			if (busy)
+				break;
+
+			hwndChild = (HWND) GetWindowLong(hwnd, DWL_USER);
+
+			// add what they wrote to the edit buffer
+			AppendToEditBuffer(hwndChild);
+
+		/** Modified by Chris Watford 14 Sept 2003, 15 Sept 2003, 16 Sept 2003 **/
+			// test if this line has an end or if it needs to be in the Edit Buffer
+			if(SendingFullCommand())
+			{
+				// send the edit buffer to the interpreter
+				//SendLastLine(hwndChild);
+				SendLastEditBuffer(hwndChild);
+				historyEntry = NULL;
+			} else {
+				AddStringToControl("  ");
+			}
+		/** End Modifications **/
+
+			break;
+			// The timer will call us 4 times a second. Look if the interpreter
+			// has written something in its end of the pipe.
+		case WM_TIMERTICK:
+		/** Modified by Chris Watford 21 Sept 2003 **/
+			hwndChild = (HWND) GetWindowLong(hwnd, DWL_USER);
+
+			if (ReadToLineBuffer())
+			{
+				int errMsg = 0;
+				char *p, *l = lineBuffer;
+
+				// Ok we read something. Display the trimmed version
+				while(((*l) == ' ') || ((*l) == '\t') || ((*l) == '\n') || ((*l) == '\r') || ((*l) == '*'))
+					l++;
+
+				SendMessage(hwndChild,EM_REPLACESEL,0,(LPARAM)l);
+
+				// fix bug where it won't find prompt
+				p = strrchr(l, '\r');
+				if((l[0] == '#') || (p != NULL))
+				{
+					if(p != NULL)
+					{
+						if(!strcmp(p, "\r\n# "))
+						{
+							SetLastPrompt(hwndChild);
+						}
+					// solve the bug Patrick found
+					} else if((l[0] == '#') && (l[1] == ' ')) {
+						SetLastPrompt(hwndChild);
+					}
+				}
+
+				// detect syntax errors
+				if(strstr(lineBuffer, "Syntax error"))
+				{
+					errMsg = WM_SYNTAXERROR;
+				} else if(strstr(lineBuffer, "Illegal character")) {
+					errMsg = WM_ILLEGALCHAR;
+				} else if(strstr(lineBuffer, "Unbound value")) {
+					errMsg = WM_UNBOUNDVAL;
+				}
+
+				// error! error! alert alert!
+				if(errMsg > 0)
+				{
+					int len = strlen(lineBuffer);
+					char* err = (char*)SafeMalloc(len+1);
+					char *m = err, *n1 = NULL, *n2 = NULL, *nt = NULL;
+
+					// make a copy of the message
+					strncpy(err, lineBuffer, len);
+					err[len] = '\0';
+
+					// find it
+					m = strstr(err, "Characters ");
+					if(m == NULL)
+						break;
+
+					// got the start char
+					n1 = m + strlen("Characters ");
+					
+					// start looking for the end char
+					nt = strstr(n1, "-");
+					if(nt == NULL)
+						break;
+					
+					// makes n1 a valid string
+					nt[0] = '\0';
+
+					// end char is right after this
+					n2 = nt + 1;
+
+					// find the end of n2
+					nt = strstr(n2, ":");
+					if(nt == NULL)
+						break;
+
+					// makes n2 a valid string
+					nt[0] = '\0';
+
+					SendMessage(hwndChild, errMsg, (WPARAM)atoi(n1), (LPARAM)atoi(n2));
+				}
+			}
+		/** End Modifications **/
+
+			break;
+
+	}
+	return DefMDIChildProc(hwnd, msg, wparam, lparam);
 }
 
 
 /*------------------------------------------------------------------------
- Procedure:     MainWndProc ID:1
- Purpose:       Window procedure for the frame window, that contains
-                the menu. The messages handled are:
-                WM_CREATE: Creates the mdi child window
-                WM_SIZE: resizes the status bar and the mdi child
-                window
-                WM_COMMAND: Sends the command to the dispatcher
-                WM_CLOSE: If the user confirms, it exists the program
-                WM_QUITOCAML: Stops the program unconditionally.
- Input:         Standard windows callback
- Output:
- Errors:
+Procedure:     MainWndProc ID:1
+Purpose:       Window procedure for the frame window, that contains
+the menu. The messages handled are:
+WM_CREATE: Creates the mdi child window
+WM_SIZE: resizes the status bar and the mdi child
+window
+WM_COMMAND: Sends the command to the dispatcher
+WM_CLOSE: If the user confirms, it exists the program
+WM_QUITOCAML: Stops the program unconditionally.
+Input:         Standard windows callback
+Output:
+Errors:
 ------------------------------------------------------------------------*/
 static LRESULT CALLBACK MainWndProc(HWND hwnd,UINT msg,WPARAM wParam,LPARAM lParam)
 {
-        switch (msg) {
-                // Create the MDI client invisible window
-        case WM_CREATE:
-                hwndMDIClient = CreateMdiClient(hwnd);
-        TimerId = SetTimer((HWND) 0, 0, 100, (TIMERPROC) TimerProc);
-                break;
-        // Move the child windows
-        case WM_SIZE:
-                SendMessage(hWndStatusbar,msg,wParam,lParam);
-                InitializeStatusBar(hWndStatusbar,1);
-                // Position the MDI client window between the tool and status bars
-                if (wParam != SIZE_MINIMIZED) {
-                        RECT rc, rcClient;
-
-                        GetClientRect(hwnd, &rcClient);
-                        GetWindowRect(hWndStatusbar, &rc);
-                        ScreenToClient(hwnd, (LPPOINT)&rc.left);
-                        rcClient.bottom = rc.top;
-                        MoveWindow(hwndMDIClient,rcClient.left,rcClient.top,rcClient.right-rcClient.left, rcClient.bottom-rcClient.top, TRUE);
-                }
-
-                return 0;
-                // Dispatch the menu commands
-        case WM_COMMAND:
-                HandleCommand(hwnd, wParam,lParam);
-                return 0;
-                // If user confirms close
-        case WM_CLOSE:
-                if (!AskYesOrNo("Quit Ocaml?"))
-                        return 0;
-                break;
-                // End application
-        case WM_DESTROY:
-                PostQuitMessage(0);
-                break;
-                // The interpreter has exited. Force close of the application
-        case WM_QUITOCAML:
-                DestroyWindow(hwnd);
-                return 0;
-        case WM_USER+1000:
-                // TestGraphics();
-                break;
-        default:
-                return DefFrameProc(hwnd,hwndMDIClient,msg,wParam,lParam);
-        }
-        return DefFrameProc(hwnd,hwndMDIClient,msg,wParam,lParam);
+	switch (msg) {
+		// Create the MDI client invisible window
+		case WM_CREATE:
+			hwndMDIClient = CreateMdiClient(hwnd);
+			TimerId = SetTimer((HWND) 0, 0, 100, (TIMERPROC) TimerProc);
+			break;
+			// Move the child windows
+		case WM_SIZE:
+			SendMessage(hWndStatusbar,msg,wParam,lParam);
+			InitializeStatusBar(hWndStatusbar,1);
+			// Position the MDI client window between the tool and status bars
+			if (wParam != SIZE_MINIMIZED) {
+				RECT rc, rcClient;
+
+				GetClientRect(hwnd, &rcClient);
+				GetWindowRect(hWndStatusbar, &rc);
+				ScreenToClient(hwnd, (LPPOINT)&rc.left);
+				rcClient.bottom = rc.top;
+				MoveWindow(hwndMDIClient,rcClient.left,rcClient.top,rcClient.right-rcClient.left, rcClient.bottom-rcClient.top, TRUE);
+			}
+
+			return 0;
+			// Dispatch the menu commands
+		case WM_COMMAND:
+			HandleCommand(hwnd, wParam,lParam);
+			return 0;
+			// If user confirms close
+		case WM_CLOSE:
+			if (!AskYesOrNo("Quit OCamlWinPlus?"))
+				return 0;
+			break;
+			// End application
+		case WM_DESTROY:
+			PostQuitMessage(0);
+			break;
+			// The interpreter has exited. Force close of the application
+		case WM_QUITOCAML:
+			DestroyWindow(hwnd);
+			return 0;
+		case WM_USER+1000:
+			// TestGraphics();
+			break;
+		default:
+			return DefFrameProc(hwnd,hwndMDIClient,msg,wParam,lParam);
+	}
+	return DefFrameProc(hwnd,hwndMDIClient,msg,wParam,lParam);
 }
 
 /*------------------------------------------------------------------------
- Procedure:     CreationCourier ID:1
- Purpose:       Creates the courier font
- Input:
- Output:
- Errors:
+Procedure:     CreationCourier ID:1
+Purpose:       Creates the courier font
+Input:
+Output:
+Errors:
 ------------------------------------------------------------------------*/
 static HFONT CreationCourier(int flag)
 {
-   LOGFONT CurrentFont;
-   memset(&CurrentFont, 0, sizeof(LOGFONT));
-   CurrentFont.lfCharSet = ANSI_CHARSET;
-   CurrentFont.lfWeight = FW_NORMAL;
-   if (flag)
-      CurrentFont.lfHeight = 18;
-   else
-      CurrentFont.lfHeight = 15;
-   CurrentFont.lfPitchAndFamily = (BYTE) (FIXED_PITCH | FF_MODERN);
-   strcpy(CurrentFont.lfFaceName, "Courier");  /* Courier */
-   return (CreateFontIndirect(&CurrentFont));
+	LOGFONT CurrentFont;
+	memset(&CurrentFont, 0, sizeof(LOGFONT));
+	CurrentFont.lfCharSet = ANSI_CHARSET;
+	CurrentFont.lfWeight = FW_NORMAL;
+	if (flag)
+		CurrentFont.lfHeight = 18;
+	else
+		CurrentFont.lfHeight = 15;
+	CurrentFont.lfPitchAndFamily = (BYTE) (FIXED_PITCH | FF_MODERN);
+	strcpy(CurrentFont.lfFaceName, "Courier");  /* Courier */
+	return (CreateFontIndirect(&CurrentFont));
 }
 
 /*------------------------------------------------------------------------
- Procedure:     ReadToLineBuffer ID:1
- Purpose:       Reads into the line buffer the characters written by
-                the interpreter
- Input:         None
- Output:        The number of characters read
- Errors:        None
+Procedure:     ReadToLineBuffer ID:1
+Purpose:       Reads into the line buffer the characters written by
+the interpreter
+Input:         None
+Output:        The number of characters read
+Errors:        None
 ------------------------------------------------------------------------*/
 int ReadToLineBuffer(void)
 {
-        memset(lineBuffer,0,sizeof(lineBuffer));
-        return ReadFromPipe(lineBuffer,sizeof(lineBuffer));
+	memset(lineBuffer,0,sizeof(lineBuffer));
+	return ReadFromPipe(lineBuffer,sizeof(lineBuffer));
 }
 
 /*------------------------------------------------------------------------
- Procedure:     AddLineBuffer ID:1
- Purpose:       Sends the contents of the line buffer to the edit
-                control
- Input:         None
- Output:
- Errors:
+Procedure:     AddLineBuffer ID:1
+Purpose:       Sends the contents of the line buffer to the edit
+control
+Input:         None
+Output:
+Errors:
 ------------------------------------------------------------------------*/
 int AddLineBuffer(void)
 {
-        HWND hEditCtrl;
+	HWND hEditCtrl;
 
-        hEditCtrl = (HWND)GetWindowLong(hwndSession,DWL_USER);
-        return SendMessage(hEditCtrl,EM_REPLACESEL,0,(LPARAM)lineBuffer);
+	hEditCtrl = (HWND)GetWindowLong(hwndSession,DWL_USER);
+	return SendMessage(hEditCtrl,EM_REPLACESEL,0,(LPARAM)lineBuffer);
 
 }
 
 /*------------------------------------------------------------------------
- Procedure:     Setup ID:1
- Purpose:       Handles GUI initialization (Fonts, brushes, colors,
-                etc)
- Input:
- Output:
- Errors:
+Procedure:     Setup ID:1
+Purpose:       Handles GUI initialization (Fonts, brushes, colors,
+etc)
+Input:
+Output:
+Errors:
 ------------------------------------------------------------------------*/
 static int Setup(HANDLE *phAccelTable)
 {
-        if (!InitApplication())
-                return 0;
-        ProgramParams.hFont = CreationCourier(1);
-        ProgramParams.TextColor = RGB(0,0,0);
-        GetObject(ProgramParams.hFont,sizeof(LOGFONT),&CurrentFont);
-        BackgroundBrush = CreateSolidBrush(BackColor);
-        *phAccelTable = LoadAccelerators(hInst,MAKEINTRESOURCE(IDACCEL));
-        return 1;
+	if (!InitApplication())
+		return 0;
+	ProgramParams.hFont = CreationCourier(1);
+	ProgramParams.TextColor = RGB(0,0,0);
+	GetObject(ProgramParams.hFont,sizeof(LOGFONT),&CurrentFont);
+	BackgroundBrush = CreateSolidBrush(BackColor);
+	*phAccelTable = LoadAccelerators(hInst,MAKEINTRESOURCE(IDACCEL));
+	return 1;
 }
 
 
 /*------------------------------------------------------------------------
- Procedure:     WinMain ID:1
- Purpose:       Entry point for windows programs.
- Input:
- Output:
- Errors:
+Procedure:     WinMain ID:1
+Purpose:       Entry point for windows programs.
+Input:
+Output:
+Errors:
 ------------------------------------------------------------------------*/
 int WINAPI WinMain(HINSTANCE hInstance, HINSTANCE hPrevInstance, LPSTR lpCmdLine, INT nCmdShow)
 {
-        MSG msg;
-        HANDLE hAccelTable;
-        char consoleTitle[512];
-        HWND hwndConsole;
-
-        // Setup the hInst global
-        hInst = hInstance;
-        // Do the setup
-        if (!Setup(&hAccelTable))
-                return 0;
-        // Need to set up a console so that we can send ctrl-break signal
-        // to inferior Caml
-        AllocConsole();
-        GetConsoleTitle(consoleTitle,sizeof(consoleTitle));
-        hwndConsole = FindWindow(NULL,consoleTitle);
-        ShowWindow(hwndConsole,SW_HIDE);
-        // Create main window and exit if this fails
-        if ((hwndMain = CreateinriaWndClassWnd()) == (HWND)0)
-                return 0;
-        // Create the status bar
-        CreateSBar(hwndMain,"Ready",2);
-        // Show the window
-        ShowWindow(hwndMain,SW_SHOW);
-        // Create the session window
-        hwndSession = MDICmdFileNew("Session transcript",0);
-        // Get the path to ocaml.exe
-        GetOcamlPath();
-        // Start the interpreter
-        StartOcaml();
-        // Show the session window
-        ShowWindow(hwndSession, SW_SHOW);
-        // Maximize it
-    SendMessage(hwndMDIClient, WM_MDIMAXIMIZE, (WPARAM) hwndSession, 0);
-
-        PostMessage(hwndMain,WM_USER+1000,0,0);
-        while (GetMessage(&msg,NULL,0,0)) {
-                if (!TranslateMDISysAccel(hwndMDIClient, &msg))
-                        if (!TranslateAccelerator(msg.hwnd, hAccelTable, &msg)) {
-                                TranslateMessage(&msg);  // Translates virtual key codes
-                                DispatchMessage(&msg);   // Dispatches message to window
-                        }
-        }
-        WriteToPipe("#quit;;\r\n\032");
-    KillTimer((HWND) 0, TimerId);
-        return msg.wParam;
+	MSG msg;
+	HANDLE hAccelTable;
+	char consoleTitle[512];
+	HWND hwndConsole;
+
+	CurrentEditBuffer = (EditBuffer*)SafeMalloc(sizeof(EditBuffer));
+	CurrentEditBuffer->LineCount = 0;
+	CurrentEditBuffer->Lines = NULL;
+
+	//setup the history index pointer
+	historyEntry = NULL;
+
+	// Setup the hInst global
+	hInst = hInstance;
+	// Do the setup
+	if (!Setup(&hAccelTable))
+		return 0;
+	// Need to set up a console so that we can send ctrl-break signal
+	// to inferior Caml
+	AllocConsole();
+	GetConsoleTitle(consoleTitle,sizeof(consoleTitle));
+	hwndConsole = FindWindow(NULL,consoleTitle);
+	ShowWindow(hwndConsole,SW_HIDE);
+	// Create main window and exit if this fails
+	if ((hwndMain = CreateinriaWndClassWnd()) == (HWND)0)
+		return 0;
+	// Create the status bar
+	CreateSBar(hwndMain,"Ready",2);
+	// Show the window
+	ShowWindow(hwndMain,SW_SHOW);
+	// Create the session window
+	hwndSession = MDICmdFileNew("Session transcript",0);
+	// Get the path to ocaml.exe
+	GetOcamlPath();
+	// Start the interpreter
+	StartOcaml();
+	// Show the session window
+	ShowWindow(hwndSession, SW_SHOW);
+	// Maximize it
+	SendMessage(hwndMDIClient, WM_MDIMAXIMIZE, (WPARAM) hwndSession, 0);
+
+	PostMessage(hwndMain,WM_USER+1000,0,0);
+	while (GetMessage(&msg,NULL,0,0)) {
+		if (!TranslateMDISysAccel(hwndMDIClient, &msg))
+			if (!TranslateAccelerator(msg.hwnd, hAccelTable, &msg)) {
+				TranslateMessage(&msg);  // Translates virtual key codes
+				DispatchMessage(&msg);   // Dispatches message to window
+			}
+	}
+	WriteToPipe("#quit;;\r\n\032");
+	KillTimer((HWND) 0, TimerId);
+	return msg.wParam;
 }
diff --git a/win32caml/ocaml.rc b/win32caml/ocaml.rc
index 3497f5cb50..52ae949742 100644
--- a/win32caml/ocaml.rc
+++ b/win32caml/ocaml.rc
@@ -1,114 +1,255 @@
-/***********************************************************************/
-/*                                                                     */
-/*                           Objective Caml                            */
-/*                                                                     */
-/*  Developed by Jacob Navia.                                          */
-/*  Copyright 2001 Institut National de Recherche en Informatique et   */
-/*  en Automatique.  All rights reserved.  This file is distributed    */
-/*  under the terms of the GNU Library General Public License, with    */
-/*  the special exception on linking described in file ../LICENSE.     */
-/*                                                                     */
-/***********************************************************************/
-
-/* $Id$ */
-
-/* Wedit generated resource file */
-#include <windows.h>
+// Microsoft Visual C++ generated resource script.
+//
+#include "resource.h"
+
+#define APSTUDIO_READONLY_SYMBOLS
+/////////////////////////////////////////////////////////////////////////////
+//
+// Generated from the TEXTINCLUDE 2 resource.
+//
+#define APSTUDIO_HIDDEN_SYMBOLS
+#include "windows.h"
+#undef APSTUDIO_HIDDEN_SYMBOLS
 #include "inriares.h"
 
-1000 ICON "ocaml.ico"
-IDMAINMENU MENU
+/////////////////////////////////////////////////////////////////////////////
+#undef APSTUDIO_READONLY_SYMBOLS
+
+/////////////////////////////////////////////////////////////////////////////
+// English (U.S.) resources
+
+#if !defined(AFX_RESOURCE_DLL) || defined(AFX_TARG_ENU)
+#ifdef _WIN32
+LANGUAGE LANG_ENGLISH, SUBLANG_ENGLISH_US
+#pragma code_page(1252)
+#endif //_WIN32
+
+/////////////////////////////////////////////////////////////////////////////
+//
+// Icon
+//
+
+// Icon with lowest ID value placed first to ensure application icon
+// remains consistent on all systems.
+1000                    ICON                    "ocaml.ico"
+
+/////////////////////////////////////////////////////////////////////////////
+//
+// Menu
+//
+
+IDMAINMENU MENU 
 BEGIN
     POPUP "&File"
-        BEGIN
-        MENUITEM "&Open...", IDM_OPEN
-        MENUITEM "&Save", IDM_SAVE
-        MENUITEM "Save &As...", IDM_SAVEAS
-        MENUITEM "&Close", IDM_CLOSE
+    BEGIN
+        MENUITEM "&Open...",                    IDM_OPEN
+        MENUITEM "&Save ML...",                 IDM_SAVE
+        MENUITEM "Save &Transcript...",         IDM_SAVEAS
         MENUITEM SEPARATOR
-        MENUITEM "&Print", IDM_PRINT
-        MENUITEM "P&rint Setup...", IDM_PRINTSU
+        MENUITEM "&Print",                      IDM_PRINT, GRAYED
+        MENUITEM "P&rint Setup...",             IDM_PRINTSU, GRAYED
         MENUITEM SEPARATOR
-        MENUITEM "E&xit", IDM_EXIT
-        END
+        MENUITEM "E&xit",                       IDM_EXIT
+    END
     POPUP "&Edit"
-        BEGIN
-        MENUITEM "&Undo Alt+BkSp", IDM_EDITUNDO
+    BEGIN
+        MENUITEM "&Undo\tAlt+BkSp",             IDM_EDITUNDO
         MENUITEM SEPARATOR
-        MENUITEM "Cu&t  Shift+Del", IDM_EDITCUT
-        MENUITEM "&Copy Ctrl+Ins", IDM_EDITCOPY
-        MENUITEM "&Paste        Shift+Ins", IDM_EDITPASTE
-        MENUITEM "&Delete       Del", IDM_EDITCLEAR
-        END
+        MENUITEM "Cu&t\t Shift+Del",            IDM_EDITCUT
+        MENUITEM "&Copy\tCtrl+Ins",             IDM_EDITCOPY
+        MENUITEM "&Paste\tShift+Ins",           IDM_EDITPASTE
+    END
     POPUP "Workspace"
-        BEGIN
-        MENUITEM "Font", IDM_FONT
-        MENUITEM "Text Color", IDM_COLORTEXT
-        MENUITEM "Background color", IDM_BACKCOLOR
+    BEGIN
+        MENUITEM "&Font...",                    IDM_FONT
+        MENUITEM "Text &Color...",              IDM_COLORTEXT
+        MENUITEM "&Background Color...",        IDM_BACKCOLOR
         MENUITEM SEPARATOR
-        MENUITEM "&History", IDM_HISTORY
-        MENUITEM "&Garbage collect", IDM_GC
-        MENUITEM "&Interrupt", IDCTRLC
-        END
-    POPUP "&Window"
-        BEGIN
-        MENUITEM "&Tile", IDM_WINDOWTILE
-        MENUITEM "&Cascade", IDM_WINDOWCASCADE
-        MENUITEM "Arrange &Icons", IDM_WINDOWICONS
-        MENUITEM "Close &All", IDM_WINDOWCLOSEALL
-        END
+        MENUITEM "&History...",                 IDM_HISTORY
+        MENUITEM "&Garbage Collect",            IDM_GC
+        MENUITEM "&Interrupt",                  IDCTRLC
+    END
+    POPUP "&Window", GRAYED
+    BEGIN
+        MENUITEM "&Tile",                       IDM_WINDOWTILE, INACTIVE
+        MENUITEM "&Cascade",                    IDM_WINDOWCASCADE, INACTIVE
+        MENUITEM "Arrange &Icons",              IDM_WINDOWICONS, INACTIVE
+        MENUITEM "Close &All",                  IDM_WINDOWCLOSEALL, INACTIVE
+    END
     POPUP "&Help"
-        BEGIN
-        MENUITEM "&About...", IDM_ABOUT
-        END
+    BEGIN
+        MENUITEM "&About...",                   IDM_ABOUT
+    END
 END
-BARMDI ACCELERATORS
+
+
+/////////////////////////////////////////////////////////////////////////////
+//
+// Accelerator
+//
+
+BARMDI ACCELERATORS 
 BEGIN
-    81, IDM_EXIT, VIRTKEY, CONTROL 
+    "Q",            IDM_EXIT,               VIRTKEY, CONTROL
 END
 
+
+/////////////////////////////////////////////////////////////////////////////
+//
+// Dialog
+//
+
 IDD_ABOUT DIALOGEX 7, 29, 236, 81
-STYLE DS_CENTER | WS_POPUP | WS_VISIBLE | WS_CAPTION | WS_SYSMENU
-EXSTYLE WS_EX_CLIENTEDGE | WS_EX_TOOLWINDOW
-CAPTION "About Ocaml"
-FONT 8, "MS Sans Serif"
+STYLE DS_SETFONT | DS_CENTER | WS_POPUP | WS_VISIBLE | WS_CAPTION | 
+    WS_SYSMENU
+EXSTYLE WS_EX_TOOLWINDOW | WS_EX_CLIENTEDGE
+CAPTION "About OCamlWinPlus"
+FONT 8, "MS Sans Serif", 0, 0, 0x1
 BEGIN
-    LTEXT           "The Objective Caml system for windows", 101, 56, 9, 126, 12
-    LTEXT           "Windows Interface 2.0", 102, 78, 21, 72, 12
-    LTEXT           "Copyright 1996-2001", 103, 84, 42, 66, 10
-    CTEXT           "Institut National de Recherche en Informatique et Automatique", 104, 15, 56, 211, 10
-    CTEXT           "R�alis� par Jacob Navia 2001", 105, 19, 66, 207, 12
+    LTEXT           "Objective Caml for Windows",101,75,7,90,12
+    LTEXT           "New Windows Interface 1.9RC4",102,68,15,104,12
+    CTEXT           "Copyright 1996-2001\nUpdated 2003",103,88,25,66,23
+    CTEXT           "Institut National de Recherche en Informatique et Automatique",
+                    104,16,46,211,10
+    CTEXT           "R�alis� par Jacob Navia 2001.  Updated by Chris Watford 2003.\nwatford@uiuc.edu",
+                    105,18,54,207,19
 END
 
 IDD_HISTORY DIALOGEX 6, 18, 261, 184
-STYLE DS_MODALFRAME | WS_POPUP | WS_VISIBLE | WS_CAPTION | WS_SYSMENU | WS_THICKFRAME
+STYLE DS_SETFONT | DS_MODALFRAME | WS_POPUP | WS_VISIBLE | WS_CAPTION | 
+    WS_SYSMENU | WS_THICKFRAME
 EXSTYLE WS_EX_TOOLWINDOW
 CAPTION "Session History"
-FONT 8, "MS Sans Serif"
-BEGIN
-    LISTBOX         IDLIST, 7, 7, 247, 173, LBS_USETABSTOPS | WS_VSCROLL | WS_HSCROLL | WS_TABSTOP
-END
-STRINGTABLE
-BEGIN
-    3010, "Switches to "
-    2010, "Get help"
-    2000, "Create, open, save, or print documents"
-    500, "Displays information about this application"
-    440, "Closes all open windows"
-    430, "Arranges minimized window icons"
-    420, "Arranges windows as overlapping tiles"
-    410, "Arranges windows as non-overlapping tiles"
-    350, "Removes the selection without putting it on the clipboard"
-    340, "Inserts the clipboard contents at the insertion point"
-    330, "Copies the selection and puts it on the clipboard"
-    320, "Cuts the selection and puts it on the clipboard"
-    310, "Reverses the last action"
-    270, "Quits this application"
-    260, "Changes the printer selection or configuration"
-    250, "Prints the active document"
-    240, "Closes the active document"
-    230, "Saves the active document under a different name"
-    220, "Saves the active document"
-    210, "Opens an existing document"
-    200, "Creates a new session"
+FONT 8, "MS Sans Serif", 0, 0, 0x1
+BEGIN
+    LISTBOX         IDLIST,7,7,247,173,LBS_USETABSTOPS | WS_VSCROLL | 
+                    WS_HSCROLL | WS_TABSTOP
+END
+
+
+#ifdef APSTUDIO_INVOKED
+/////////////////////////////////////////////////////////////////////////////
+//
+// TEXTINCLUDE
+//
+
+1 TEXTINCLUDE 
+BEGIN
+    "resource.h\0"
+END
+
+2 TEXTINCLUDE 
+BEGIN
+    "#define APSTUDIO_HIDDEN_SYMBOLS\r\n"
+    "#include ""windows.h""\r\n"
+    "#undef APSTUDIO_HIDDEN_SYMBOLS\r\n"
+    "#include ""inriares.h""\r\n"
+    "\0"
+END
+
+3 TEXTINCLUDE 
+BEGIN
+    "\r\n"
+    "\0"
+END
+
+#endif    // APSTUDIO_INVOKED
+
+
+/////////////////////////////////////////////////////////////////////////////
+//
+// String Table
+//
+
+STRINGTABLE 
+BEGIN
+    3010                    "Switches to "
+END
+
+STRINGTABLE 
+BEGIN
+    2000                    "Create, open, save, or print documents"
+    2010                    "Get help"
+END
+
+STRINGTABLE 
+BEGIN
+    500                     "Displays information about this application"
+END
+
+STRINGTABLE 
+BEGIN
+    440                     "Closes all open windows"
+END
+
+STRINGTABLE 
+BEGIN
+    420                     "Arranges windows as overlapping tiles"
+    430                     "Arranges minimized window icons"
+END
+
+STRINGTABLE 
+BEGIN
+    410                     "Arranges windows as non-overlapping tiles"
+END
+
+STRINGTABLE 
+BEGIN
+    340                     "Inserts the clipboard contents at the insertion point"
+    350                     "Removes the selection without putting it on the clipboard"
+END
+
+STRINGTABLE 
+BEGIN
+    320                     "Cuts the selection and puts it on the clipboard"
+    330                     "Copies the selection and puts it on the clipboard"
+END
+
+STRINGTABLE 
+BEGIN
+    310                     "Reverses the last action"
+END
+
+STRINGTABLE 
+BEGIN
+    260                     "Changes the printer selection or configuration"
+    270                     "Quits this application"
 END
+
+STRINGTABLE 
+BEGIN
+    240                     "Closes the active document"
+    250                     "Prints the active document"
+END
+
+STRINGTABLE 
+BEGIN
+    230                     "Saves the active document under a different name"
+END
+
+STRINGTABLE 
+BEGIN
+    210                     "Opens an existing document"
+    220                     "Saves the active document"
+END
+
+STRINGTABLE 
+BEGIN
+    200                     "Creates a new session"
+END
+
+#endif    // English (U.S.) resources
+/////////////////////////////////////////////////////////////////////////////
+
+
+
+#ifndef APSTUDIO_INVOKED
+/////////////////////////////////////////////////////////////////////////////
+//
+// Generated from the TEXTINCLUDE 3 resource.
+//
+
+
+/////////////////////////////////////////////////////////////////////////////
+#endif    // not APSTUDIO_INVOKED
+
diff --git a/win32caml/startocaml.c b/win32caml/startocaml.c
index 37ebde1c20..578d407cb3 100644
--- a/win32caml/startocaml.c
+++ b/win32caml/startocaml.c
@@ -10,49 +10,55 @@
 /*                                                                     */
 /***********************************************************************/
 
+/***********************************************************************/
+/* Changes made by Chris Watford to enhance the source editor          */
+/* Began 14 Sept 2003 - watford@uiuc.edu                               */
+/***********************************************************************/
+
 /* $Id$ */
 
 #include <windows.h>
 #include <stdio.h>
-#include <direct.h>
 #include <io.h>
+#include <direct.h>
 #include "inria.h"
+extern int _get_osfhandle(int);
 PROCESS_INFORMATION pi;
 #define BUFSIZE 4096
 STARTUPINFO startInfo;
 
 /*------------------------------------------------------------------------
- Procedure:     ShowDbgMsg ID:1
- Purpose:       Puts up a dialog box with a message, forcing it to
-                the foreground.
- Input:
- Output:
- Errors:
+Procedure:     ShowDbgMsg ID:1
+Purpose:       Puts up a dialog box with a message, forcing it to
+the foreground.
+Input:
+Output:
+Errors:
 ------------------------------------------------------------------------*/
 void ShowDbgMsg(char *str)
 {
-        HWND hWnd;
-        char p[20], message[255];
-        hWnd = hwndMain;
-        if (IsIconic(hWnd)){
-                ShowWindow(hWnd,SW_RESTORE);
-        }
-        strncpy(message, str, 254);
-        message[254] = 0;
-        strcpy(p, "Error");
-        MessageBox(hWnd, message, p, MB_OK | MB_ICONHAND|MB_TASKMODAL|MB_SETFOREGROUND);
+	HWND hWnd;
+	char p[20], message[255];
+	hWnd = hwndMain;
+	if (IsIconic(hWnd)){
+		ShowWindow(hWnd,SW_RESTORE);
+	}
+	strncpy(message, str, 254);
+	message[254] = 0;
+	strcpy(p, "Error");
+	MessageBox(hWnd, message, p, MB_OK | MB_ICONHAND|MB_TASKMODAL|MB_SETFOREGROUND);
 }
 
 int AskYesOrNo(char *msg)
 {
-        HWND hwnd;
-        int r;
-
-        hwnd = hwndMain;
-        r = MessageBox(hwnd, msg, "Ocaml", MB_YESNO | MB_SETFOREGROUND);
-        if (r == IDYES)
-                return (TRUE);
-        return (FALSE);
+	HWND hwnd;
+	int r;
+
+	hwnd = hwndMain;
+	r = MessageBox(hwnd, msg, "Ocaml", MB_YESNO | MB_SETFOREGROUND);
+	if (r == IDYES)
+		return (TRUE);
+	return (FALSE);
 }
 
 
@@ -60,305 +66,306 @@ static DWORD OcamlStatus;
 
 static int RegistryError(void)
 {
-        char buf[512];
+	char buf[512];
 
-        wsprintf(buf,"Error %d writing to the registry",GetLastError());
-        ShowDbgMsg(buf);
-        return 0;
+	wsprintf(buf,"Error %d writing to the registry",GetLastError());
+	ShowDbgMsg(buf);
+	return 0;
 }
 
 static int ReadRegistry(HKEY hroot,
-                        char * p1, char * p2, char * p3,
-                        char dest[1024])
+						char * p1, char * p2, char * p3,
+						char dest[1024])
 {
-  HKEY h1, h2;
-  DWORD dwType;
-  unsigned long size;
-  LONG ret;
-
-  if (RegOpenKeyExA(hroot, p1, 0, KEY_QUERY_VALUE, &h1) != ERROR_SUCCESS)
-    return 0;
-  if (RegOpenKeyExA(h1, p2, 0, KEY_QUERY_VALUE, &h2) != ERROR_SUCCESS) {
-    RegCloseKey(h1);
-    return 0;
-  }
-  dwType = REG_SZ;
-  size = 1024;
-  ret = RegQueryValueExA(h2, p3, 0, &dwType, dest, &size);
-  RegCloseKey(h2);
-  RegCloseKey(h1);
-  return ret == ERROR_SUCCESS;
+	HKEY h1, h2;
+	DWORD dwType;
+	unsigned long size;
+	LONG ret;
+
+	if (RegOpenKeyExA(hroot, p1, 0, KEY_QUERY_VALUE, &h1) != ERROR_SUCCESS)
+		return 0;
+	if (RegOpenKeyExA(h1, p2, 0, KEY_QUERY_VALUE, &h2) != ERROR_SUCCESS) {
+		RegCloseKey(h1);
+		return 0;
+	}
+	dwType = REG_SZ;
+	size = 1024;
+	ret = RegQueryValueExA(h2, p3, 0, &dwType, dest, &size);
+	RegCloseKey(h2);
+	RegCloseKey(h1);
+	return ret == ERROR_SUCCESS;
 }
 
 static int WriteRegistry(HKEY hroot,
-                          char * p1, char * p2, char * p3,
-                          char data[1024])
+						 char * p1, char * p2, char * p3,
+						 char data[1024])
 {
-  HKEY h1, h2;
-  DWORD disp;
-  LONG ret;
-
-  if (RegOpenKeyExA(hroot, p1, 0, KEY_QUERY_VALUE, &h1) != ERROR_SUCCESS)
-    return 0;
-  if (RegCreateKeyExA(h1, p2, 0, NULL, 0, KEY_ALL_ACCESS, NULL, &h2, &disp)
-      != ERROR_SUCCESS) {
-    RegCloseKey(h1);
-    return 0;
-  }
-  ret = RegSetValueEx(h2, p3, 0, REG_SZ, data, strlen(data) + 1);
-  RegCloseKey(h2);
-  RegCloseKey(h1);
-  return ret == ERROR_SUCCESS;
+	HKEY h1, h2;
+	DWORD disp;
+	LONG ret;
+
+	if (RegOpenKeyExA(hroot, p1, 0, KEY_QUERY_VALUE, &h1) != ERROR_SUCCESS)
+		return 0;
+	if (RegCreateKeyExA(h1, p2, 0, NULL, 0, KEY_ALL_ACCESS, NULL, &h2, &disp)
+		!= ERROR_SUCCESS) {
+			RegCloseKey(h1);
+			return 0;
+		}
+		ret = RegSetValueEx(h2, p3, 0, REG_SZ, data, strlen(data) + 1);
+		RegCloseKey(h2);
+		RegCloseKey(h1);
+		return ret == ERROR_SUCCESS;
 }
 
 /*------------------------------------------------------------------------
- Procedure:     GetOcamlPath ID:1
- Purpose:       Read the registry key 
-                HKEY_LOCAL_MACHINE\Software\Objective Caml
-                or
-                HKEY_CURRENT_USER\Software\Objective Caml,
-                and creates it if it doesn't exists.
-                If any error occurs, i.e. the
-                given path doesn't exist, or the key didn't exist, it
-                will put up a browse dialog box to allow the user to
-                enter the path. The path will be verified that it
-                points to a file that exists. If that file is in a
-                directory called 'bin', it will look for another
-                directory in the same level called lib' and set the
-                Lib path to that.
- Input:         None explicit
- Output:        1 means sucess, zero failure
- Errors:        Almost all system calls will be verified
+Procedure:     GetOcamlPath ID:1
+Purpose:       Read the registry key 
+HKEY_LOCAL_MACHINE\Software\Objective Caml
+or
+HKEY_CURRENT_USER\Software\Objective Caml,
+and creates it if it doesn't exists.
+If any error occurs, i.e. the
+given path doesn't exist, or the key didn't exist, it
+will put up a browse dialog box to allow the user to
+enter the path. The path will be verified that it
+points to a file that exists. If that file is in a
+directory called 'bin', it will look for another
+directory in the same level called lib' and set the
+Lib path to that.
+Input:         None explicit
+Output:        1 means sucess, zero failure
+Errors:        Almost all system calls will be verified
 ------------------------------------------------------------------------*/
 int GetOcamlPath(void)
 {
-  char path[1024], *p;
-
- again:
-  if (! ReadRegistry(HKEY_CURRENT_USER,
-                     "Software", "Objective Caml",
-                     "InterpreterPath", path)
-      &&
-      ! ReadRegistry(HKEY_LOCAL_MACHINE,
-                     "Software", "Objective Caml",
-                     "InterpreterPath", path)) {
-    /* Key doesn't exist?  Ask user */
-    path[0] = '\0';
-    if (!BrowseForFile("Ocaml interpreter|ocaml.exe", path)) {
-      ShowDbgMsg("Impossible to find ocaml.exe. I quit");
-      exit(0);
-    }
-    WriteRegistry(HKEY_CURRENT_USER,
-                  "Software", "Objective Caml",
-                  "InterpreterPath", path);
-  }
-  /* Check if file exists */
-  if (_access(path, 0) != 0) {
-    char *errormsg = malloc(1024);
-    wsprintf(errormsg,"Incorrect path for ocaml.exe:\n%s", path);
-    ShowDbgMsg(errormsg);
-    free(errormsg);
-    path[0] = 0;
-    WriteRegistry(HKEY_CURRENT_USER,
-                  "Software", "Objective Caml",
-                  "InterpreterPath", path);
-    goto again;
-  }
-  strcpy(OcamlPath, path);
-  p = strrchr(OcamlPath,'\\');
-  if (p) {
-    *p = 0;
-    strcpy(LibDir,OcamlPath);
-    *p = '\\';
-    p = strrchr(LibDir,'\\');
-    if (p && !stricmp(p,"\\bin")) {
-      *p = 0;
-      strcat(LibDir,"\\lib");
-    }
-  }
-  return 1;
+	char path[1024], *p;
+
+again:
+	if (! ReadRegistry(HKEY_CURRENT_USER,
+		"Software", "Objective Caml",
+		"InterpreterPath", path)
+		&&
+		! ReadRegistry(HKEY_LOCAL_MACHINE,
+		"Software", "Objective Caml",
+		"InterpreterPath", path)) {
+			/* Key doesn't exist?  Ask user */
+			if (!BrowseForFile("Ocaml interpreter|ocaml.exe", path)) {
+				ShowDbgMsg("Impossible to find ocaml.exe. I quit");
+				exit(0);
+			}
+			WriteRegistry(HKEY_CURRENT_USER,
+				"Software", "Objective Caml",
+				"InterpreterPath", path);
+		}
+		/* Check if file exists */
+		if (_access(path, 0) != 0) {
+			char *errormsg = malloc(1024);
+			wsprintf(errormsg,"Incorrect path for ocaml.exe:\n%s", path);
+			ShowDbgMsg(errormsg);
+			free(errormsg);
+			path[0] = 0;
+			WriteRegistry(HKEY_CURRENT_USER,
+				"Software", "Objective Caml",
+				"InterpreterPath", path);
+			goto again;
+		}
+		strcpy(OcamlPath, path);
+		p = strrchr(OcamlPath,'\\');
+		if (p) {
+			*p = 0;
+			strcpy(LibDir,OcamlPath);
+			*p = '\\';
+			p = strrchr(LibDir,'\\');
+			if (p && !stricmp(p,"\\bin")) {
+				*p = 0;
+				strcat(LibDir,"\\lib");
+			}
+		}
+		return 1;
 }
 
 static HANDLE hChildStdinRd, hChildStdinWr,hChildStdoutRd, hChildStdoutWr;
 /*------------------------------------------------------------------------
- Procedure:     IsWindowsNT ID:1
- Purpose:       Returns 1 if we are running under windows NT, zero
-                otherwise.
- Input:         None
- Output:        1 or zero
- Errors:
+Procedure:     IsWindowsNT ID:1
+Purpose:       Returns 1 if we are running under windows NT, zero
+otherwise.
+Input:         None
+Output:        1 or zero
+Errors:
 ------------------------------------------------------------------------*/
 int IsWindowsNT(void)
 {
-        OSVERSIONINFO osv;
+	OSVERSIONINFO osv;
 
-        osv.dwOSVersionInfoSize = sizeof(osv);
-        GetVersionEx(&osv);
-        return(osv.dwPlatformId == VER_PLATFORM_WIN32_NT);
+	osv.dwOSVersionInfoSize = sizeof(osv);
+	GetVersionEx(&osv);
+	return(osv.dwPlatformId == VER_PLATFORM_WIN32_NT);
 }
 
 /*------------------------------------------------------------------------
- Procedure:     DoStartOcaml ID:1
- Purpose:       Starts the ocaml interpreter ocaml.exe. The standard
-                input of the interpreter will be connected to a pipe,
-                and the standard output and standard error to another
-                pipe. The interpreter starts as a hidden process,
-                showing only in the task list. Since this is in an
-                own thread, its workings are independent of the rest
-                of the program. After starting the interpreter, the
-                thread waits in case the interpreter exits, for
-                instance if the user or some program types #quit;;.
-                In this case, the waiting thread awakens and exits
-                the user interface.
- Input:         Not used. It uses the OcamlPath global variable, that
-                is supposed to be correct, no test for its validity
-                are done here.
- Output:        None visible
- Errors:        If any system call for whatever reason fails, the
-                thread will exit. No error message is shown.
+Procedure:     DoStartOcaml ID:1
+Purpose:       Starts the ocaml interpreter ocaml.exe. The standard
+input of the interpreter will be connected to a pipe,
+and the standard output and standard error to another
+pipe. The interpreter starts as a hidden process,
+showing only in the task list. Since this is in an
+own thread, its workings are independent of the rest
+of the program. After starting the interpreter, the
+thread waits in case the interpreter exits, for
+instance if the user or some program types #quit;;.
+In this case, the waiting thread awakens and exits
+the user interface.
+Input:         Not used. It uses the OcamlPath global variable, that
+is supposed to be correct, no test for its validity
+are done here.
+Output:        None visible
+Errors:        If any system call for whatever reason fails, the
+thread will exit. No error message is shown.
 ------------------------------------------------------------------------*/
-DWORD _stdcall DoStartOcaml(LPVOID param)
+int _stdcall DoStartOcaml(HWND hwndParent)
 {
-        char *cmdline;
-        int processStarted;
-        LPSECURITY_ATTRIBUTES lpsa=NULL;
-        SECURITY_ATTRIBUTES sa;
-        SECURITY_DESCRIPTOR sd;
-	HWND hwndParent = (HWND) param;
-
-        sa.nLength = sizeof(SECURITY_ATTRIBUTES);
-        // Under windows NT/2000/Whistler we have to initialize the security descriptors
-        // This is not necessary under windows 98/95.
-        if (IsWindowsNT()) {
-                InitializeSecurityDescriptor(&sd,SECURITY_DESCRIPTOR_REVISION);
-                SetSecurityDescriptorDacl(&sd,TRUE,NULL,FALSE);
-                sa.bInheritHandle = TRUE;
-                sa.lpSecurityDescriptor = &sd;
-                lpsa = &sa;
-        }
-        memset(&startInfo,0,sizeof(STARTUPINFO));
-        startInfo.cb = sizeof(STARTUPINFO);
-        // Create a pipe for the child process's STDOUT.
-        if (! CreatePipe(&hChildStdoutRd, &hChildStdoutWr, &sa, 0))
-                return 0;
-        // Create a pipe for the child process's STDIN.
-        if (! CreatePipe(&hChildStdinRd, &hChildStdinWr, &sa, 0))
-                return 0;
-        // Setup the start info structure
-        startInfo.dwFlags = STARTF_USESTDHANDLES|STARTF_USESHOWWINDOW;
-        startInfo.wShowWindow = SW_HIDE;
-        startInfo.hStdOutput = hChildStdoutWr;
-        startInfo.hStdError = hChildStdoutWr;
-        startInfo.hStdInput = hChildStdinRd;
-        cmdline = OcamlPath;
-        // Set the OCAMLLIB environment variable
-        SetEnvironmentVariable("OCAMLLIB", LibDir);
-        // Let's go: start the ocaml interpreter
-        processStarted = CreateProcess(NULL,cmdline,lpsa,lpsa,1,
-                CREATE_NEW_PROCESS_GROUP|NORMAL_PRIORITY_CLASS,
-                NULL,ProgramParams.CurrentWorkingDir,&startInfo,&pi);
-        if (processStarted) {
-                WaitForSingleObject(pi.hProcess,INFINITE);
-                GetExitCodeProcess(pi.hProcess,(unsigned long *)&OcamlStatus);
-                CloseHandle(pi.hProcess);
-                PostMessage(hwndMain,WM_QUITOCAML,0,0);
-        }
-        else {
-                char *msg = malloc(1024);
-                wsprintf(msg,"Impossible to start ocaml.exe in:\n%s",cmdline);
-                ShowDbgMsg(msg);
-                free(msg);
-        }
-        return 0;
+	char *cmdline;
+	int processStarted;
+	LPSECURITY_ATTRIBUTES lpsa=NULL;
+	SECURITY_ATTRIBUTES sa;
+	SECURITY_DESCRIPTOR sd;
+
+	sa.nLength = sizeof(SECURITY_ATTRIBUTES);
+	// Under windows NT/2000/Whistler we have to initialize the security descriptors
+	// This is not necessary under windows 98/95.
+	if (IsWindowsNT()) {
+		InitializeSecurityDescriptor(&sd,SECURITY_DESCRIPTOR_REVISION);
+		SetSecurityDescriptorDacl(&sd,TRUE,NULL,FALSE);
+		sa.bInheritHandle = TRUE;
+		sa.lpSecurityDescriptor = &sd;
+		lpsa = &sa;
+	}
+	memset(&startInfo,0,sizeof(STARTUPINFO));
+	startInfo.cb = sizeof(STARTUPINFO);
+	// Create a pipe for the child process's STDOUT.
+	if (! CreatePipe(&hChildStdoutRd, &hChildStdoutWr, &sa, 0))
+		return 0;
+	// Create a pipe for the child process's STDIN.
+	if (! CreatePipe(&hChildStdinRd, &hChildStdinWr, &sa, 0))
+		return 0;
+	// Setup the start info structure
+	startInfo.dwFlags = STARTF_USESTDHANDLES|STARTF_USESHOWWINDOW;
+	startInfo.wShowWindow = SW_HIDE;
+	startInfo.hStdOutput = hChildStdoutWr;
+	startInfo.hStdError = hChildStdoutWr;
+	startInfo.hStdInput = hChildStdinRd;
+	cmdline = OcamlPath;
+	// Set the OCAMLLIB environment variable
+	SetEnvironmentVariable("OCAMLLIB", LibDir);
+	// Let's go: start the ocaml interpreter
+	processStarted = CreateProcess(NULL,cmdline,lpsa,lpsa,1,
+		CREATE_NEW_PROCESS_GROUP|NORMAL_PRIORITY_CLASS,
+		NULL,ProgramParams.CurrentWorkingDir,&startInfo,&pi);
+	if (processStarted) {
+		WaitForSingleObject(pi.hProcess,INFINITE);
+		GetExitCodeProcess(pi.hProcess,(unsigned long *)&OcamlStatus);
+		CloseHandle(pi.hProcess);
+		PostMessage(hwndMain,WM_QUITOCAML,0,0);
+	}
+	else {
+		char *msg = malloc(1024);
+		wsprintf(msg,"Impossible to start ocaml.exe in:\n%s",cmdline);
+		ShowDbgMsg(msg);
+		free(msg);
+	}
+	return 0;
 }
 
 /*------------------------------------------------------------------------
- Procedure:     WriteToPipe ID:1
- Purpose:       Writes the given character string to the standard
-                input of the interpreter
- Input:         The character string (zero terminated) to be written
- Output:        The number of characters written or zero if an error
-                occurs
- Errors:        None
+Procedure:     WriteToPipe ID:1
+Purpose:       Writes the given character string to the standard
+input of the interpreter
+Input:         The character string (zero terminated) to be written
+Output:        The number of characters written or zero if an error
+occurs
+Errors:        None
 ------------------------------------------------------------------------*/
 int WriteToPipe(char *data)
 {
-        DWORD dwWritten;
-        if (! WriteFile(hChildStdinWr, data, strlen(data),
-                &dwWritten, NULL))
-                return 0;
-        return dwWritten;
+	DWORD dwWritten;
+
+	if (! WriteFile(hChildStdinWr, data, strlen(data), &dwWritten, NULL))
+		return 0;
+
+	return dwWritten;
 
 }
 
 /*------------------------------------------------------------------------
- Procedure:     ReadFromPipe ID:1
- Purpose:       Reads from the standard output of the interpreter and
-                stores the data in the given buffer up to the given
-                length. This is done in a non-blocking manner, i.e.
-                it is safe to call this even if there is no data
-                available.
- Input:         The buffer to be used and its length.
- Output:        Returns the number of characters read from the pipe.
- Errors:        None explicit
+Procedure:     ReadFromPipe ID:1
+Purpose:       Reads from the standard output of the interpreter and
+stores the data in the given buffer up to the given
+length. This is done in a non-blocking manner, i.e.
+it is safe to call this even if there is no data
+available.
+Input:         The buffer to be used and its length.
+Output:        Returns the number of characters read from the pipe.
+Errors:        None explicit
 ------------------------------------------------------------------------*/
 int ReadFromPipe(char *data,int len)
 {
-        DWORD dwRead;
+	DWORD dwRead;
 
-        PeekNamedPipe(hChildStdoutRd,data,len,NULL,&dwRead,NULL);
-        if (dwRead == 0)
-                return 0;
+	PeekNamedPipe(hChildStdoutRd,data,len,NULL,&dwRead,NULL);
+	if (dwRead == 0)
+		return 0;
 
-        // Read output from the child process, and write to parent's STDOUT.
-        if( !ReadFile( hChildStdoutRd, data, len, &dwRead,
-                NULL) || dwRead == 0)
-                return 0;
-        return dwRead;
+	// Read output from the child process, and write to parent's STDOUT.
+	if( !ReadFile( hChildStdoutRd, data, len, &dwRead, NULL) || dwRead == 0)
+		return 0;
+
+	return dwRead;
 }
 
 static DWORD tid;
 /*------------------------------------------------------------------------
- Procedure:     StartOcaml ID:1
- Purpose:       Starts the thread that will call the ocaml.exe
-                program.
- Input:
- Output:
- Errors:
+Procedure:     StartOcaml ID:1
+Purpose:       Starts the thread that will call the ocaml.exe
+program.
+Input:
+Output:
+Errors:
 ------------------------------------------------------------------------*/
 int StartOcaml(void)
 {
-        getcwd(ProgramParams.CurrentWorkingDir,sizeof(ProgramParams.CurrentWorkingDir));
-        CreateThread(NULL,0,DoStartOcaml,hwndMain,0,&tid);
-        return 1;
+	getcwd(ProgramParams.CurrentWorkingDir,sizeof(ProgramParams.CurrentWorkingDir));
+	CreateThread(NULL,0,DoStartOcaml,hwndMain,0,&tid);
+	return 1;
 }
 
 
 void *SafeMalloc(int size)
 {
-        void *result;
+	void *result;
 
-        if (size < 0) {
-                char message[1024];
+	if (size < 0) {
+		char message[1024];
 
 error:
-                sprintf(message,"Can't allocate %d bytes",size);
-                MessageBox(NULL,message,"Ocaml",MB_OK);
-                exit(-1);
-        }
-        result = malloc(size);
-        if (result == NULL)
-                goto error;
-        return result;
+		sprintf(message,"Can't allocate %d bytes",size);
+		MessageBox(NULL, message, "Ocaml", MB_OK);
+		exit(-1);
+	}
+	result = malloc(size);
+
+	if (result == NULL)
+		goto error;
+
+	return result;
 }
 
 
 void InterruptOcaml(void)
 {
-  if (! GenerateConsoleCtrlEvent(CTRL_BREAK_EVENT, pi.dwProcessId)) {
-    char message[1024];
-    sprintf(message, "GenerateConsole failed: %ld\n", GetLastError());
-    MessageBox(NULL, message, "Ocaml", MB_OK);
-  }
-  WriteToPipe(" ");
+	if (!GenerateConsoleCtrlEvent(CTRL_BREAK_EVENT, pi.dwProcessId)) {
+		char message[1024];
+		sprintf(message, "GenerateConsole failed: %d\n", GetLastError());
+		MessageBox(NULL, message, "Ocaml", MB_OK);
+	}
+	WriteToPipe(" ");
 }
diff --git a/yacc/defs.h b/yacc/defs.h
index a65e543232..6c368fbd6d 100644
--- a/yacc/defs.h
+++ b/yacc/defs.h
@@ -22,10 +22,6 @@
 #include <stdlib.h>
 #include "../config/s.h"
 
-#if macintosh
-#include "../byterun/rotatecursor.h"
-#endif
-
 /*  machine-dependent definitions                              */
 /*  the following definitions are for the Tahoe                */
 /*  they might have to be changed for other machines           */
@@ -120,19 +116,6 @@
 
 /*  storage allocation macros  */
 
-#if macintosh
-
-#define INTERACT() ROTATECURSOR_MAGIC ()
-
-#define CALLOC(k,n)  (INTERACT (), calloc((unsigned)(k),(unsigned)(n)))
-#define FREE(x)      (INTERACT (), free((char*)(x)))
-#define MALLOC(n)    (INTERACT (), malloc((unsigned)(n)))
-#define NEW(t)       (INTERACT (), (t*)allocate(sizeof(t)))
-#define NEW2(n,t)    (INTERACT (), (t*)allocate((unsigned)((n)*sizeof(t))))
-#define REALLOC(p,n) (INTERACT (), realloc((char*)(p),(unsigned)(n)))
-
-#else
-
 #define CALLOC(k,n)      (calloc((unsigned)(k),(unsigned)(n)))
 #define FREE(x)          (free((char*)(x)))
 #define MALLOC(n)        (malloc((unsigned)(n)))
@@ -140,8 +123,6 @@
 #define NEW2(n,t)        ((t*)allocate((unsigned)((n)*sizeof(t))))
 #define REALLOC(p,n)     (realloc((char*)(p),(unsigned)(n)))
 
-#endif /* macintosh */
-
 
 /*  the structure of a symbol table entry  */
 
@@ -234,6 +215,7 @@ extern char *myname;
 extern char *cptr;
 extern char *line;
 extern int lineno;
+extern char *virtual_input_file_name;
 extern int outline;
 
 extern char *action_file_name;
diff --git a/yacc/error.c b/yacc/error.c
index 81218b026d..6e01a34388 100644
--- a/yacc/error.c
+++ b/yacc/error.c
@@ -42,7 +42,7 @@ void open_error(char *filename)
 void unexpected_EOF(void)
 {
     fprintf(stderr, "%s: e - line %d of \"%s\", unexpected end-of-file\n",
-            myname, lineno, input_file_name);
+            myname, lineno, virtual_input_file_name);
     done(1);
 }
 
@@ -54,7 +54,7 @@ void print_pos(char *st_line, char *st_cptr)
     if (st_line == 0) return;
     for (s = st_line; *s != '\n'; ++s)
     {
-        if (isprint(*s) || *s == '\t')
+        if (isprint((unsigned char) *s) || *s == '\t')
             putc(*s, stderr);
         else
             putc('?', stderr);
@@ -75,7 +75,7 @@ void print_pos(char *st_line, char *st_cptr)
 void syntax_error(int st_lineno, char *st_line, char *st_cptr)
 {
     fprintf(stderr, "%s: e - line %d of \"%s\", syntax error\n",
-            myname, st_lineno, input_file_name);
+            myname, st_lineno, virtual_input_file_name);
     print_pos(st_line, st_cptr);
     done(1);
 }
@@ -84,7 +84,7 @@ void syntax_error(int st_lineno, char *st_line, char *st_cptr)
 void unterminated_comment(int c_lineno, char *c_line, char *c_cptr)
 {
     fprintf(stderr, "%s: e - line %d of \"%s\", unmatched /*\n",
-            myname, c_lineno, input_file_name);
+            myname, c_lineno, virtual_input_file_name);
     print_pos(c_line, c_cptr);
     done(1);
 }
@@ -93,7 +93,7 @@ void unterminated_comment(int c_lineno, char *c_line, char *c_cptr)
 void unterminated_string(int s_lineno, char *s_line, char *s_cptr)
 {
     fprintf(stderr, "%s: e - line %d of \"%s\", unterminated string\n",
-            myname, s_lineno, input_file_name);
+            myname, s_lineno, virtual_input_file_name);
     print_pos(s_line, s_cptr);
     done(1);
 }
@@ -102,7 +102,7 @@ void unterminated_string(int s_lineno, char *s_line, char *s_cptr)
 void unterminated_text(int t_lineno, char *t_line, char *t_cptr)
 {
     fprintf(stderr, "%s: e - line %d of \"%s\", unmatched %%{\n",
-            myname, t_lineno, input_file_name);
+            myname, t_lineno, virtual_input_file_name);
     print_pos(t_line, t_cptr);
     done(1);
 }
@@ -111,7 +111,7 @@ void unterminated_text(int t_lineno, char *t_line, char *t_cptr)
 void unterminated_union(int u_lineno, char *u_line, char *u_cptr)
 {
     fprintf(stderr, "%s: e - line %d of \"%s\", unterminated %%union \
-declaration\n", myname, u_lineno, input_file_name);
+declaration\n", myname, u_lineno, virtual_input_file_name);
     print_pos(u_line, u_cptr);
     done(1);
 }
@@ -120,7 +120,7 @@ declaration\n", myname, u_lineno, input_file_name);
 void over_unionized(char *u_cptr)
 {
     fprintf(stderr, "%s: e - line %d of \"%s\", too many %%union \
-declarations\n", myname, lineno, input_file_name);
+declarations\n", myname, lineno, virtual_input_file_name);
     print_pos(line, u_cptr);
     done(1);
 }
@@ -129,7 +129,7 @@ declarations\n", myname, lineno, input_file_name);
 void illegal_tag(int t_lineno, char *t_line, char *t_cptr)
 {
     fprintf(stderr, "%s: e - line %d of \"%s\", illegal tag\n",
-            myname, t_lineno, input_file_name);
+            myname, t_lineno, virtual_input_file_name);
     print_pos(t_line, t_cptr);
     done(1);
 }
@@ -138,7 +138,7 @@ void illegal_tag(int t_lineno, char *t_line, char *t_cptr)
 void illegal_character(char *c_cptr)
 {
     fprintf(stderr, "%s: e - line %d of \"%s\", illegal character\n",
-            myname, lineno, input_file_name);
+            myname, lineno, virtual_input_file_name);
     print_pos(line, c_cptr);
     done(1);
 }
@@ -147,7 +147,7 @@ void illegal_character(char *c_cptr)
 void used_reserved(char *s)
 {
     fprintf(stderr, "%s: e - line %d of \"%s\", illegal use of reserved symbol \
-%s\n", myname, lineno, input_file_name, s);
+%s\n", myname, lineno, virtual_input_file_name, s);
     done(1);
 }
 
@@ -155,7 +155,7 @@ void used_reserved(char *s)
 void tokenized_start(char *s)
 {
      fprintf(stderr, "%s: e - line %d of \"%s\", the start symbol %s cannot be \
-declared to be a token\n", myname, lineno, input_file_name, s);
+declared to be a token\n", myname, lineno, virtual_input_file_name, s);
      done(1);
 }
 
@@ -163,35 +163,35 @@ declared to be a token\n", myname, lineno, input_file_name, s);
 void retyped_warning(char *s)
 {
     fprintf(stderr, "%s: w - line %d of \"%s\", the type of %s has been \
-redeclared\n", myname, lineno, input_file_name, s);
+redeclared\n", myname, lineno, virtual_input_file_name, s);
 }
 
 
 void reprec_warning(char *s)
 {
     fprintf(stderr, "%s: w - line %d of \"%s\", the precedence of %s has been \
-redeclared\n", myname, lineno, input_file_name, s);
+redeclared\n", myname, lineno, virtual_input_file_name, s);
 }
 
 
 void revalued_warning(char *s)
 {
     fprintf(stderr, "%s: w - line %d of \"%s\", the value of %s has been \
-redeclared\n", myname, lineno, input_file_name, s);
+redeclared\n", myname, lineno, virtual_input_file_name, s);
 }
 
 
 void terminal_start(char *s)
 {
     fprintf(stderr, "%s: e - line %d of \"%s\", the entry point %s is a \
-token\n", myname, lineno, input_file_name, s);
+token\n", myname, lineno, virtual_input_file_name, s);
     done(1);
 }
 
 void too_many_entries(void)
 {
     fprintf(stderr, "%s: e - line %d of \"%s\", more than 256 entry points\n",
-            myname, lineno, input_file_name);
+            myname, lineno, virtual_input_file_name);
     done(1);
 }
 
@@ -199,7 +199,7 @@ void too_many_entries(void)
 void no_grammar(void)
 {
     fprintf(stderr, "%s: e - line %d of \"%s\", no grammar has been \
-specified\n", myname, lineno, input_file_name);
+specified\n", myname, lineno, virtual_input_file_name);
     done(1);
 }
 
@@ -207,7 +207,7 @@ specified\n", myname, lineno, input_file_name);
 void terminal_lhs(int s_lineno)
 {
     fprintf(stderr, "%s: e - line %d of \"%s\", a token appears on the lhs \
-of a production\n", myname, s_lineno, input_file_name);
+of a production\n", myname, s_lineno, virtual_input_file_name);
     done(1);
 }
 
@@ -215,14 +215,14 @@ of a production\n", myname, s_lineno, input_file_name);
 void prec_redeclared(void)
 {
     fprintf(stderr, "%s: w - line %d of  \"%s\", conflicting %%prec \
-specifiers\n", myname, lineno, input_file_name);
+specifiers\n", myname, lineno, virtual_input_file_name);
 }
 
 
 void unterminated_action(int a_lineno, char *a_line, char *a_cptr)
 {
     fprintf(stderr, "%s: e - line %d of \"%s\", unterminated action\n",
-            myname, a_lineno, input_file_name);
+            myname, a_lineno, virtual_input_file_name);
     print_pos(a_line, a_cptr);
     done(1);
 }
@@ -231,14 +231,14 @@ void unterminated_action(int a_lineno, char *a_line, char *a_cptr)
 void dollar_warning(int a_lineno, int i)
 {
     fprintf(stderr, "%s: w - line %d of \"%s\", $%d references beyond the \
-end of the current rule\n", myname, a_lineno, input_file_name, i);
+end of the current rule\n", myname, a_lineno, virtual_input_file_name, i);
 }
 
 
 void dollar_error(int a_lineno, char *a_line, char *a_cptr)
 {
     fprintf(stderr, "%s: e - line %d of \"%s\", illegal $-name\n",
-            myname, a_lineno, input_file_name);
+            myname, a_lineno, virtual_input_file_name);
     print_pos(a_line, a_cptr);
     done(1);
 }
@@ -247,7 +247,7 @@ void dollar_error(int a_lineno, char *a_line, char *a_cptr)
 void untyped_lhs(void)
 {
     fprintf(stderr, "%s: e - line %d of \"%s\", $$ is untyped\n",
-            myname, lineno, input_file_name);
+            myname, lineno, virtual_input_file_name);
     done(1);
 }
 
@@ -255,7 +255,7 @@ void untyped_lhs(void)
 void untyped_rhs(int i, char *s)
 {
     fprintf(stderr, "%s: e - line %d of \"%s\", $%d (%s) is untyped\n",
-            myname, lineno, input_file_name, i, s);
+            myname, lineno, virtual_input_file_name, i, s);
     done(1);
 }
 
@@ -263,21 +263,21 @@ void untyped_rhs(int i, char *s)
 void unknown_rhs(int i)
 {
     fprintf(stderr, "%s: e - line %d of \"%s\", $%d is unbound\n",
-            myname, lineno, input_file_name, i);
+            myname, lineno, virtual_input_file_name, i);
     done(1);
 }
 
 void illegal_token_ref(int i, char *name)
 {
     fprintf(stderr, "%s: e - line %d of \"%s\", $%d refers to terminal `%s', which has no argument\n",
-            myname, lineno, input_file_name, i, name);
+            myname, lineno, virtual_input_file_name, i, name);
     done(1);
 }
 
 void default_action_error(void)
 {
     fprintf(stderr, "%s: e - line %d of \"%s\", no action specified for this production\n",
-            myname, lineno, input_file_name);
+            myname, lineno, virtual_input_file_name);
     done(1);
 }
 
diff --git a/yacc/main.c b/yacc/main.c
index 3f2f9ef8e7..978aac0e0c 100644
--- a/yacc/main.c
+++ b/yacc/main.c
@@ -39,6 +39,7 @@ char temp_form[] = "yacc.XXXXXXX";
 #endif
 
 int lineno;
+char *virtual_input_file_name = NULL;
 int outline;
 
 char *action_file_name;
diff --git a/yacc/reader.c b/yacc/reader.c
index 5ab9997d63..07d1287e0b 100644
--- a/yacc/reader.c
+++ b/yacc/reader.c
@@ -155,6 +155,51 @@ void skip_comment(void)
     }
 }
 
+char *substring (char *str, int start, int len)
+{
+  int i;
+  char *buf = MALLOC (len+1);
+  if (buf == NULL) return NULL;
+  for (i = 0; i < len; i++){
+    buf[i] = str[start+i];
+  }
+  return buf;
+}
+
+void parse_line_directive (void)
+{
+  int i = 0, j = 0;
+  int line_number = 0;
+  char *file_name = NULL;
+
+ again:
+  if (line == 0) return;
+  if (line[i] != '#') return;
+  ++ i;
+  while (line[i] == ' ' || line[i] == '\t') ++ i;
+  if (line[i] < '0' || line[i] > '9') return;
+  while (line[i] >= '0' && line[i] <= '9'){
+    line_number = line_number * 10 + line[i] - '0';
+    ++ i;
+  }
+  while (line[i] == ' ' || line[i] == '\t') ++ i;
+  if (line[i] == '"'){
+    ++ i;
+    j = i;
+    while (line[j] != '"' && line[j] != '\0') ++j;
+    if (line[j] == '"'){
+      file_name = substring (line, i, j - i);
+      if (file_name == NULL) no_space ();
+    }
+  }
+  lineno = line_number - 1;
+  if (file_name != NULL){
+    if (virtual_input_file_name != NULL) FREE (virtual_input_file_name);
+    virtual_input_file_name = file_name;
+  }
+  get_line ();
+  goto again;
+}
 
 int
 nextc(void)
@@ -164,6 +209,7 @@ nextc(void)
     if (line == 0)
     {
         get_line();
+        parse_line_directive ();
         if (line == 0)
             return (EOF);
     }
@@ -175,6 +221,7 @@ nextc(void)
         {
         case '\n':
             get_line();
+            parse_line_directive ();
             if (line == 0) return (EOF);
             s = cptr;
             break;
@@ -204,6 +251,7 @@ nextc(void)
             else if (s[1] == '/')
             {
                 get_line();
+                parse_line_directive ();
                 if (line == 0) return (EOF);
                 s = cptr;
                 break;
@@ -380,8 +428,11 @@ loop:
           fwrite(cptr, 1, 2, f);
           cptr += 2;
         } else
-        if (cptr[0] == '\\' && isdigit(cptr[1]) && isdigit(cptr[2]) &&
-            isdigit(cptr[3]) && cptr[4] == '\'') {
+        if (cptr[0] == '\\'
+            && isdigit((unsigned char) cptr[1])
+            && isdigit((unsigned char) cptr[2])
+            && isdigit((unsigned char) cptr[3])
+            && cptr[4] == '\'') {
           fwrite(cptr, 1, 5, f);
           cptr += 5;
         } else
@@ -726,10 +777,10 @@ is_reserved(char *name)
             strcmp(name, "$end") == 0)
         return (1);
 
-    if (name[0] == '$' && name[1] == '$' && isdigit(name[2]))
+    if (name[0] == '$' && name[1] == '$' && isdigit((unsigned char) name[2]))
     {
         s = name + 3;
-        while (isdigit(*s)) ++s;
+        while (isdigit((unsigned char) *s)) ++s;
         if (*s == NUL) return (1);
     }
 
@@ -1245,7 +1296,7 @@ loop:
     c = *cptr;
     if (c == '$')
     {
-        if (isdigit(cptr[1]))
+        if (isdigit((unsigned char) cptr[1]))
         {
             ++cptr;
             i = get_number();
@@ -1336,8 +1387,11 @@ loop:
           fwrite(cptr, 1, 2, f);
           cptr += 2;
         } else
-        if (cptr[0] == '\\' && isdigit(cptr[1]) && isdigit(cptr[2]) &&
-            isdigit(cptr[3]) && cptr[4] == '\'') {
+        if (cptr[0] == '\\' 
+            && isdigit((unsigned char) cptr[1])
+            && isdigit((unsigned char) cptr[2])
+            && isdigit((unsigned char) cptr[3])
+            && cptr[4] == '\'') {
           fwrite(cptr, 1, 5, f);
           cptr += 5;
         } else
@@ -1823,6 +1877,8 @@ void print_grammar(void)
 
 void reader(void)
 {
+    virtual_input_file_name = substring (input_file_name, 0,
+                                         strlen (input_file_name));
     create_symbol_table();
     read_declarations();
     output_token_type();