Sync with trunk. Rebinding of inlined extension constructors with free variables is not yet supported.

git-svn-id: http://caml.inria.fr/svn/ocaml/branches/constructors_with_record3@15069 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
author: Alain Frisch <alain@frisch.fr> 2014-08-07 16:07:55 +0000
committer: Alain Frisch <alain@frisch.fr> 2014-08-07 16:07:55 +0000
commit: 50f47df33a6061e1acd015dbb0dcffcdd51e0f2f (patch)
tree: 568e704c3ff8e8e055573cc44efa4d522b0341f1
parent: 9e23ded0d195e861ad9ed7d0801ed1c3a0ed34e3 (diff)
parent: 047e09748c91e1d8f80b51edfc33de76fbfc57da (diff)
download: ocaml-50f47df33a6061e1acd015dbb0dcffcdd51e0f2f.tar.gz
464 files changed, 21177 insertions, 8359 deletions
diff --git a/.depend b/.depend
index f0ecc73c2c..a8b99a9b0d 100644
--- a/.depend
+++ b/.depend
@@ -1,4 +1,4 @@
-putils/ccomp.cmi :
+utils/ccomp.cmi :
 utils/clflags.cmi :
 utils/config.cmi :
 utils/consistbl.cmi :
@@ -44,10 +44,12 @@ parsing/ast_helper.cmo : parsing/parsetree.cmi parsing/longident.cmi \
 parsing/ast_helper.cmx : parsing/parsetree.cmi parsing/longident.cmx \
     parsing/location.cmx parsing/asttypes.cmi parsing/ast_helper.cmi
 parsing/ast_mapper.cmo : parsing/parsetree.cmi utils/misc.cmi \
-    parsing/location.cmi utils/config.cmi parsing/ast_helper.cmi \
+    parsing/longident.cmi parsing/location.cmi utils/config.cmi \
+    utils/clflags.cmi parsing/asttypes.cmi parsing/ast_helper.cmi \
     parsing/ast_mapper.cmi
 parsing/ast_mapper.cmx : parsing/parsetree.cmi utils/misc.cmx \
-    parsing/location.cmx utils/config.cmx parsing/ast_helper.cmx \
+    parsing/longident.cmx parsing/location.cmx utils/config.cmx \
+    utils/clflags.cmx parsing/asttypes.cmi parsing/ast_helper.cmx \
     parsing/ast_mapper.cmi
 parsing/lexer.cmo : utils/warnings.cmi parsing/parser.cmi utils/misc.cmi \
     parsing/location.cmi parsing/lexer.cmi
@@ -134,23 +136,23 @@ typing/typedtree.cmi : typing/types.cmi typing/primitive.cmi typing/path.cmi \
     typing/ident.cmi typing/env.cmi parsing/asttypes.cmi
 typing/typedtreeIter.cmi : typing/typedtree.cmi parsing/asttypes.cmi
 typing/typedtreeMap.cmi : typing/typedtree.cmi
-typing/typemod.cmi : typing/types.cmi typing/typedtree.cmi \
+typing/typemod.cmi : typing/types.cmi typing/typedtree.cmi typing/path.cmi \
     parsing/parsetree.cmi parsing/longident.cmi parsing/location.cmi \
-    typing/includemod.cmi typing/ident.cmi typing/env.cmi
+    typing/includemod.cmi typing/ident.cmi typing/env.cmi \
+    parsing/asttypes.cmi
 typing/types.cmi : typing/primitive.cmi typing/path.cmi \
     parsing/parsetree.cmi parsing/longident.cmi parsing/location.cmi \
     typing/ident.cmi parsing/asttypes.cmi
-typing/typetexp.cmi : utils/warnings.cmi typing/types.cmi \
-    typing/typedtree.cmi typing/path.cmi parsing/parsetree.cmi \
-    parsing/longident.cmi parsing/location.cmi typing/env.cmi \
-    parsing/asttypes.cmi
+typing/typetexp.cmi : typing/types.cmi typing/typedtree.cmi typing/path.cmi \
+    parsing/parsetree.cmi parsing/longident.cmi parsing/location.cmi \
+    typing/env.cmi parsing/asttypes.cmi parsing/ast_mapper.cmi
 typing/btype.cmo : typing/types.cmi typing/path.cmi utils/misc.cmi \
     typing/ident.cmi typing/btype.cmi
 typing/btype.cmx : typing/types.cmx typing/path.cmx utils/misc.cmx \
     typing/ident.cmx typing/btype.cmi
-typing/cmi_format.cmo : typing/types.cmi utils/misc.cmi parsing/location.cmi \
+typing/cmi_format.cmo : typing/types.cmi parsing/location.cmi \
     utils/config.cmi typing/cmi_format.cmi
-typing/cmi_format.cmx : typing/types.cmx utils/misc.cmx parsing/location.cmx \
+typing/cmi_format.cmx : typing/types.cmx parsing/location.cmx \
     utils/config.cmx typing/cmi_format.cmi
 typing/cmt_format.cmo : typing/types.cmi typing/typedtreeMap.cmi \
     typing/typedtree.cmi utils/misc.cmi parsing/location.cmi \
@@ -168,12 +170,12 @@ typing/ctype.cmx : typing/types.cmx typing/subst.cmx typing/path.cmx \
     utils/misc.cmx parsing/longident.cmx parsing/location.cmx \
     typing/ident.cmx typing/env.cmx utils/clflags.cmx typing/btype.cmx \
     parsing/asttypes.cmi typing/ctype.cmi
-typing/datarepr.cmo : typing/types.cmi typing/predef.cmi typing/path.cmi \
-    parsing/location.cmi typing/ident.cmi typing/btype.cmi \
-    parsing/asttypes.cmi typing/datarepr.cmi
-typing/datarepr.cmx : typing/types.cmx typing/predef.cmx typing/path.cmx \
-    parsing/location.cmx typing/ident.cmx typing/btype.cmx \
-    parsing/asttypes.cmi typing/datarepr.cmi
+typing/datarepr.cmo : typing/types.cmi typing/path.cmi parsing/location.cmi \
+    typing/ident.cmi typing/btype.cmi parsing/asttypes.cmi \
+    typing/datarepr.cmi
+typing/datarepr.cmx : typing/types.cmx typing/path.cmx parsing/location.cmx \
+    typing/ident.cmx typing/btype.cmx parsing/asttypes.cmi \
+    typing/datarepr.cmi
 typing/env.cmo : utils/warnings.cmi typing/types.cmi utils/tbl.cmi \
     typing/subst.cmi typing/predef.cmi typing/path.cmi utils/misc.cmi \
     parsing/longident.cmi parsing/location.cmi typing/ident.cmi \
@@ -207,15 +209,17 @@ typing/includecore.cmx : typing/types.cmx typing/typedtree.cmx \
     typing/env.cmx typing/ctype.cmx typing/btype.cmx parsing/asttypes.cmi \
     typing/includecore.cmi
 typing/includemod.cmo : typing/types.cmi typing/typedtree.cmi utils/tbl.cmi \
-    typing/subst.cmi typing/printtyp.cmi typing/path.cmi typing/mtype.cmi \
-    utils/misc.cmi parsing/location.cmi typing/includecore.cmi \
-    typing/includeclass.cmi typing/ident.cmi typing/env.cmi typing/ctype.cmi \
-    typing/cmt_format.cmi utils/clflags.cmi typing/includemod.cmi
+    typing/subst.cmi typing/printtyp.cmi typing/primitive.cmi typing/path.cmi \
+    typing/mtype.cmi utils/misc.cmi parsing/location.cmi \
+    typing/includecore.cmi typing/includeclass.cmi typing/ident.cmi \
+    typing/env.cmi typing/ctype.cmi typing/cmt_format.cmi utils/clflags.cmi \
+    typing/includemod.cmi
 typing/includemod.cmx : typing/types.cmx typing/typedtree.cmx utils/tbl.cmx \
-    typing/subst.cmx typing/printtyp.cmx typing/path.cmx typing/mtype.cmx \
-    utils/misc.cmx parsing/location.cmx typing/includecore.cmx \
-    typing/includeclass.cmx typing/ident.cmx typing/env.cmx typing/ctype.cmx \
-    typing/cmt_format.cmx utils/clflags.cmx typing/includemod.cmi
+    typing/subst.cmx typing/printtyp.cmx typing/primitive.cmx typing/path.cmx \
+    typing/mtype.cmx utils/misc.cmx parsing/location.cmx \
+    typing/includecore.cmx typing/includeclass.cmx typing/ident.cmx \
+    typing/env.cmx typing/ctype.cmx typing/cmt_format.cmx utils/clflags.cmx \
+    typing/includemod.cmi
 typing/mtype.cmo : typing/types.cmi typing/subst.cmi typing/path.cmi \
     utils/misc.cmi parsing/location.cmi typing/ident.cmi typing/env.cmi \
     typing/ctype.cmi utils/clflags.cmi typing/btype.cmi parsing/asttypes.cmi \
@@ -231,15 +235,15 @@ typing/oprint.cmx : typing/outcometree.cmi parsing/asttypes.cmi \
 typing/parmatch.cmo : utils/warnings.cmi typing/types.cmi \
     typing/typedtree.cmi typing/subst.cmi typing/predef.cmi typing/path.cmi \
     parsing/parsetree.cmi utils/misc.cmi parsing/longident.cmi \
-    parsing/location.cmi typing/ident.cmi typing/env.cmi typing/datarepr.cmi \
-    typing/ctype.cmi typing/btype.cmi parsing/asttypes.cmi \
-    parsing/ast_helper.cmi typing/parmatch.cmi
+    parsing/location.cmi typing/ident.cmi typing/env.cmi typing/ctype.cmi \
+    typing/btype.cmi parsing/asttypes.cmi parsing/ast_helper.cmi \
+    typing/parmatch.cmi
 typing/parmatch.cmx : utils/warnings.cmx typing/types.cmx \
     typing/typedtree.cmx typing/subst.cmx typing/predef.cmx typing/path.cmx \
     parsing/parsetree.cmi utils/misc.cmx parsing/longident.cmx \
-    parsing/location.cmx typing/ident.cmx typing/env.cmx typing/datarepr.cmx \
-    typing/ctype.cmx typing/btype.cmx parsing/asttypes.cmi \
-    parsing/ast_helper.cmx typing/parmatch.cmi
+    parsing/location.cmx typing/ident.cmx typing/env.cmx typing/ctype.cmx \
+    typing/btype.cmx parsing/asttypes.cmi parsing/ast_helper.cmx \
+    typing/parmatch.cmi
 typing/path.cmo : typing/ident.cmi typing/path.cmi
 typing/path.cmx : typing/ident.cmx typing/path.cmi
 typing/predef.cmo : typing/types.cmi typing/path.cmi parsing/location.cmi \
@@ -278,8 +282,8 @@ typing/subst.cmx : typing/types.cmx utils/tbl.cmx typing/path.cmx \
     typing/btype.cmx parsing/ast_mapper.cmx typing/subst.cmi
 typing/typeclass.cmo : utils/warnings.cmi typing/typetexp.cmi \
     typing/types.cmi typing/typedtree.cmi typing/typedecl.cmi \
-    typing/typecore.cmi typing/subst.cmi typing/stypes.cmi \
-    typing/printtyp.cmi typing/predef.cmi typing/path.cmi \
+    typing/typecore.cmi parsing/syntaxerr.cmi typing/subst.cmi \
+    typing/stypes.cmi typing/printtyp.cmi typing/predef.cmi typing/path.cmi \
     parsing/parsetree.cmi typing/parmatch.cmi utils/misc.cmi \
     parsing/longident.cmi parsing/location.cmi typing/includeclass.cmi \
     typing/ident.cmi typing/env.cmi typing/ctype.cmi typing/cmt_format.cmi \
@@ -287,43 +291,43 @@ typing/typeclass.cmo : utils/warnings.cmi typing/typetexp.cmi \
     parsing/ast_helper.cmi typing/typeclass.cmi
 typing/typeclass.cmx : utils/warnings.cmx typing/typetexp.cmx \
     typing/types.cmx typing/typedtree.cmx typing/typedecl.cmx \
-    typing/typecore.cmx typing/subst.cmx typing/stypes.cmx \
-    typing/printtyp.cmx typing/predef.cmx typing/path.cmx \
+    typing/typecore.cmx parsing/syntaxerr.cmx typing/subst.cmx \
+    typing/stypes.cmx typing/printtyp.cmx typing/predef.cmx typing/path.cmx \
     parsing/parsetree.cmi typing/parmatch.cmx utils/misc.cmx \
     parsing/longident.cmx parsing/location.cmx typing/includeclass.cmx \
     typing/ident.cmx typing/env.cmx typing/ctype.cmx typing/cmt_format.cmx \
     utils/clflags.cmx typing/btype.cmx parsing/asttypes.cmi \
     parsing/ast_helper.cmx typing/typeclass.cmi
 typing/typecore.cmo : utils/warnings.cmi typing/typetexp.cmi \
-    typing/types.cmi typing/typedtree.cmi typing/subst.cmi typing/stypes.cmi \
-    typing/printtyp.cmi typing/primitive.cmi typing/predef.cmi \
-    typing/path.cmi parsing/parsetree.cmi typing/parmatch.cmi \
-    typing/oprint.cmi utils/misc.cmi parsing/longident.cmi \
-    parsing/location.cmi typing/ident.cmi typing/env.cmi typing/ctype.cmi \
-    typing/cmt_format.cmi utils/clflags.cmi typing/btype.cmi \
-    parsing/asttypes.cmi parsing/ast_helper.cmi typing/annot.cmi \
-    typing/typecore.cmi
+    typing/types.cmi typing/typedtree.cmi parsing/syntaxerr.cmi \
+    typing/subst.cmi typing/stypes.cmi typing/printtyp.cmi \
+    typing/primitive.cmi typing/predef.cmi typing/path.cmi \
+    parsing/parsetree.cmi typing/parmatch.cmi typing/oprint.cmi \
+    utils/misc.cmi parsing/longident.cmi parsing/location.cmi \
+    typing/ident.cmi typing/env.cmi typing/ctype.cmi typing/cmt_format.cmi \
+    utils/clflags.cmi typing/btype.cmi parsing/asttypes.cmi \
+    parsing/ast_helper.cmi typing/annot.cmi typing/typecore.cmi
 typing/typecore.cmx : utils/warnings.cmx typing/typetexp.cmx \
-    typing/types.cmx typing/typedtree.cmx typing/subst.cmx typing/stypes.cmx \
-    typing/printtyp.cmx typing/primitive.cmx typing/predef.cmx \
-    typing/path.cmx parsing/parsetree.cmi typing/parmatch.cmx \
-    typing/oprint.cmx utils/misc.cmx parsing/longident.cmx \
-    parsing/location.cmx typing/ident.cmx typing/env.cmx typing/ctype.cmx \
-    typing/cmt_format.cmx utils/clflags.cmx typing/btype.cmx \
-    parsing/asttypes.cmi parsing/ast_helper.cmx typing/annot.cmi \
-    typing/typecore.cmi
+    typing/types.cmx typing/typedtree.cmx parsing/syntaxerr.cmx \
+    typing/subst.cmx typing/stypes.cmx typing/printtyp.cmx \
+    typing/primitive.cmx typing/predef.cmx typing/path.cmx \
+    parsing/parsetree.cmi typing/parmatch.cmx typing/oprint.cmx \
+    utils/misc.cmx parsing/longident.cmx parsing/location.cmx \
+    typing/ident.cmx typing/env.cmx typing/ctype.cmx typing/cmt_format.cmx \
+    utils/clflags.cmx typing/btype.cmx parsing/asttypes.cmi \
+    parsing/ast_helper.cmx typing/annot.cmi typing/typecore.cmi
 typing/typedecl.cmo : utils/warnings.cmi typing/typetexp.cmi \
-    typing/types.cmi typing/typedtree.cmi typing/subst.cmi \
-    typing/printtyp.cmi typing/primitive.cmi typing/predef.cmi \
-    typing/path.cmi parsing/parsetree.cmi utils/misc.cmi \
+    typing/types.cmi typing/typedtree.cmi parsing/syntaxerr.cmi \
+    typing/subst.cmi typing/printtyp.cmi typing/primitive.cmi \
+    typing/predef.cmi typing/path.cmi parsing/parsetree.cmi utils/misc.cmi \
     parsing/longident.cmi parsing/location.cmi typing/includecore.cmi \
     typing/ident.cmi typing/env.cmi typing/ctype.cmi utils/config.cmi \
     utils/clflags.cmi typing/btype.cmi parsing/asttypes.cmi \
     parsing/ast_helper.cmi typing/typedecl.cmi
 typing/typedecl.cmx : utils/warnings.cmx typing/typetexp.cmx \
-    typing/types.cmx typing/typedtree.cmx typing/subst.cmx \
-    typing/printtyp.cmx typing/primitive.cmx typing/predef.cmx \
-    typing/path.cmx parsing/parsetree.cmi utils/misc.cmx \
+    typing/types.cmx typing/typedtree.cmx parsing/syntaxerr.cmx \
+    typing/subst.cmx typing/printtyp.cmx typing/primitive.cmx \
+    typing/predef.cmx typing/path.cmx parsing/parsetree.cmi utils/misc.cmx \
     parsing/longident.cmx parsing/location.cmx typing/includecore.cmx \
     typing/ident.cmx typing/env.cmx typing/ctype.cmx utils/config.cmx \
     utils/clflags.cmx typing/btype.cmx parsing/asttypes.cmi \
@@ -351,8 +355,8 @@ typing/typemod.cmo : utils/warnings.cmi typing/typetexp.cmi typing/types.cmi \
     typing/mtype.cmi utils/misc.cmi parsing/longident.cmi \
     parsing/location.cmi typing/includemod.cmi typing/ident.cmi \
     typing/env.cmi typing/ctype.cmi utils/config.cmi typing/cmt_format.cmi \
-    utils/clflags.cmi typing/btype.cmi parsing/asttypes.cmi typing/annot.cmi \
-    typing/typemod.cmi
+    utils/clflags.cmi typing/btype.cmi parsing/asttypes.cmi \
+    parsing/ast_mapper.cmi typing/annot.cmi typing/typemod.cmi
 typing/typemod.cmx : utils/warnings.cmx typing/typetexp.cmx typing/types.cmx \
     typing/typedtree.cmx typing/typedecl.cmx typing/typecore.cmx \
     typing/typeclass.cmx typing/subst.cmx typing/stypes.cmx \
@@ -360,8 +364,8 @@ typing/typemod.cmx : utils/warnings.cmx typing/typetexp.cmx typing/types.cmx \
     typing/mtype.cmx utils/misc.cmx parsing/longident.cmx \
     parsing/location.cmx typing/includemod.cmx typing/ident.cmx \
     typing/env.cmx typing/ctype.cmx utils/config.cmx typing/cmt_format.cmx \
-    utils/clflags.cmx typing/btype.cmx parsing/asttypes.cmi typing/annot.cmi \
-    typing/typemod.cmi
+    utils/clflags.cmx typing/btype.cmx parsing/asttypes.cmi \
+    parsing/ast_mapper.cmx typing/annot.cmi typing/typemod.cmi
 typing/types.cmo : typing/primitive.cmi typing/path.cmi \
     parsing/parsetree.cmi parsing/longident.cmi parsing/location.cmi \
     typing/ident.cmi parsing/asttypes.cmi typing/types.cmi
@@ -369,21 +373,21 @@ typing/types.cmx : typing/primitive.cmx typing/path.cmx \
     parsing/parsetree.cmi parsing/longident.cmx parsing/location.cmx \
     typing/ident.cmx parsing/asttypes.cmi typing/types.cmi
 typing/typetexp.cmo : utils/warnings.cmi typing/types.cmi \
-    typing/typedtree.cmi utils/tbl.cmi typing/printtyp.cmi typing/path.cmi \
-    parsing/parsetree.cmi utils/misc.cmi parsing/longident.cmi \
-    parsing/location.cmi typing/env.cmi typing/ctype.cmi utils/clflags.cmi \
-    typing/btype.cmi parsing/asttypes.cmi parsing/ast_helper.cmi \
-    typing/typetexp.cmi
+    typing/typedtree.cmi utils/tbl.cmi parsing/syntaxerr.cmi \
+    typing/printtyp.cmi typing/path.cmi parsing/parsetree.cmi utils/misc.cmi \
+    parsing/longident.cmi parsing/location.cmi typing/env.cmi \
+    typing/ctype.cmi utils/clflags.cmi typing/btype.cmi parsing/asttypes.cmi \
+    parsing/ast_mapper.cmi parsing/ast_helper.cmi typing/typetexp.cmi
 typing/typetexp.cmx : utils/warnings.cmx typing/types.cmx \
-    typing/typedtree.cmx utils/tbl.cmx typing/printtyp.cmx typing/path.cmx \
-    parsing/parsetree.cmi utils/misc.cmx parsing/longident.cmx \
-    parsing/location.cmx typing/env.cmx typing/ctype.cmx utils/clflags.cmx \
-    typing/btype.cmx parsing/asttypes.cmi parsing/ast_helper.cmx \
-    typing/typetexp.cmi
+    typing/typedtree.cmx utils/tbl.cmx parsing/syntaxerr.cmx \
+    typing/printtyp.cmx typing/path.cmx parsing/parsetree.cmi utils/misc.cmx \
+    parsing/longident.cmx parsing/location.cmx typing/env.cmx \
+    typing/ctype.cmx utils/clflags.cmx typing/btype.cmx parsing/asttypes.cmi \
+    parsing/ast_mapper.cmx parsing/ast_helper.cmx typing/typetexp.cmi
 bytecomp/bytegen.cmi : bytecomp/lambda.cmi bytecomp/instruct.cmi
 bytecomp/bytelibrarian.cmi :
 bytecomp/bytelink.cmi : bytecomp/symtable.cmi bytecomp/cmo_format.cmi
-bytecomp/bytepackager.cmi : typing/ident.cmi
+bytecomp/bytepackager.cmi : typing/ident.cmi typing/env.cmi
 bytecomp/bytesections.cmi :
 bytecomp/cmo_format.cmi : bytecomp/lambda.cmi typing/ident.cmi
 bytecomp/dll.cmi :
@@ -448,22 +452,20 @@ bytecomp/bytepackager.cmx : typing/typemod.cmx bytecomp/translmod.cmx \
     typing/env.cmx bytecomp/emitcode.cmx utils/config.cmx \
     bytecomp/cmo_format.cmi utils/clflags.cmx bytecomp/bytelink.cmx \
     bytecomp/bytegen.cmx bytecomp/bytepackager.cmi
-bytecomp/bytesections.cmo : utils/misc.cmi utils/config.cmi \
-    bytecomp/bytesections.cmi
-bytecomp/bytesections.cmx : utils/misc.cmx utils/config.cmx \
-    bytecomp/bytesections.cmi
+bytecomp/bytesections.cmo : utils/config.cmi bytecomp/bytesections.cmi
+bytecomp/bytesections.cmx : utils/config.cmx bytecomp/bytesections.cmi
 bytecomp/dll.cmo : utils/misc.cmi utils/config.cmi bytecomp/dll.cmi
 bytecomp/dll.cmx : utils/misc.cmx utils/config.cmx bytecomp/dll.cmi
 bytecomp/emitcode.cmo : bytecomp/translmod.cmi typing/primitive.cmi \
-    bytecomp/opcodes.cmo utils/misc.cmi bytecomp/meta.cmi bytecomp/lambda.cmi \
-    bytecomp/instruct.cmi typing/env.cmi utils/config.cmi \
-    bytecomp/cmo_format.cmi utils/clflags.cmi typing/btype.cmi \
-    parsing/asttypes.cmi bytecomp/emitcode.cmi
+    bytecomp/opcodes.cmo utils/misc.cmi bytecomp/meta.cmi \
+    parsing/location.cmi bytecomp/lambda.cmi bytecomp/instruct.cmi \
+    typing/env.cmi utils/config.cmi bytecomp/cmo_format.cmi utils/clflags.cmi \
+    typing/btype.cmi parsing/asttypes.cmi bytecomp/emitcode.cmi
 bytecomp/emitcode.cmx : bytecomp/translmod.cmx typing/primitive.cmx \
-    bytecomp/opcodes.cmx utils/misc.cmx bytecomp/meta.cmx bytecomp/lambda.cmx \
-    bytecomp/instruct.cmx typing/env.cmx utils/config.cmx \
-    bytecomp/cmo_format.cmi utils/clflags.cmx typing/btype.cmx \
-    parsing/asttypes.cmi bytecomp/emitcode.cmi
+    bytecomp/opcodes.cmx utils/misc.cmx bytecomp/meta.cmx \
+    parsing/location.cmx bytecomp/lambda.cmx bytecomp/instruct.cmx \
+    typing/env.cmx utils/config.cmx bytecomp/cmo_format.cmi utils/clflags.cmx \
+    typing/btype.cmx parsing/asttypes.cmi bytecomp/emitcode.cmi
 bytecomp/instruct.cmo : typing/types.cmi typing/subst.cmi \
     parsing/location.cmi bytecomp/lambda.cmi typing/ident.cmi typing/env.cmi \
     bytecomp/instruct.cmi
@@ -508,12 +510,12 @@ bytecomp/printlambda.cmx : typing/types.cmx typing/primitive.cmx \
     parsing/asttypes.cmi bytecomp/printlambda.cmi
 bytecomp/runtimedef.cmo : bytecomp/runtimedef.cmi
 bytecomp/runtimedef.cmx : bytecomp/runtimedef.cmi
-bytecomp/simplif.cmo : utils/tbl.cmi typing/stypes.cmi bytecomp/lambda.cmi \
-    typing/ident.cmi utils/clflags.cmi parsing/asttypes.cmi typing/annot.cmi \
-    bytecomp/simplif.cmi
-bytecomp/simplif.cmx : utils/tbl.cmx typing/stypes.cmx bytecomp/lambda.cmx \
-    typing/ident.cmx utils/clflags.cmx parsing/asttypes.cmi typing/annot.cmi \
-    bytecomp/simplif.cmi
+bytecomp/simplif.cmo : utils/tbl.cmi typing/stypes.cmi utils/misc.cmi \
+    bytecomp/lambda.cmi typing/ident.cmi utils/clflags.cmi \
+    parsing/asttypes.cmi typing/annot.cmi bytecomp/simplif.cmi
+bytecomp/simplif.cmx : utils/tbl.cmx typing/stypes.cmx utils/misc.cmx \
+    bytecomp/lambda.cmx typing/ident.cmx utils/clflags.cmx \
+    parsing/asttypes.cmi typing/annot.cmi bytecomp/simplif.cmi
 bytecomp/switch.cmo : bytecomp/switch.cmi
 bytecomp/switch.cmx : bytecomp/switch.cmi
 bytecomp/symtable.cmo : utils/tbl.cmi bytecomp/runtimedef.cmi \
@@ -576,10 +578,11 @@ bytecomp/typeopt.cmo : typing/types.cmi typing/typedtree.cmi \
 bytecomp/typeopt.cmx : typing/types.cmx typing/typedtree.cmx \
     typing/predef.cmx typing/path.cmx bytecomp/lambda.cmx typing/ident.cmx \
     typing/env.cmx typing/ctype.cmx bytecomp/typeopt.cmi
+asmcomp/CSEgen.cmi : asmcomp/mach.cmi
 asmcomp/asmgen.cmi : bytecomp/lambda.cmi asmcomp/cmm.cmi
 asmcomp/asmlibrarian.cmi :
 asmcomp/asmlink.cmi : asmcomp/cmx_format.cmi
-asmcomp/asmpackager.cmi :
+asmcomp/asmpackager.cmi : typing/env.cmi
 asmcomp/clambda.cmi : bytecomp/lambda.cmi typing/ident.cmi \
     asmcomp/debuginfo.cmi parsing/asttypes.cmi
 asmcomp/closure.cmi : bytecomp/lambda.cmi asmcomp/clambda.cmi
@@ -592,6 +595,7 @@ asmcomp/coloring.cmi :
 asmcomp/comballoc.cmi : asmcomp/mach.cmi
 asmcomp/compilenv.cmi : typing/ident.cmi asmcomp/cmx_format.cmi \
     asmcomp/clambda.cmi
+asmcomp/deadcode.cmi : asmcomp/mach.cmi
 asmcomp/debuginfo.cmi : parsing/location.cmi bytecomp/lambda.cmi
 asmcomp/emit.cmi : asmcomp/linearize.cmi asmcomp/cmm.cmi
 asmcomp/emitaux.cmi : asmcomp/debuginfo.cmi
@@ -617,6 +621,10 @@ asmcomp/selection.cmi : asmcomp/mach.cmi asmcomp/cmm.cmi
 asmcomp/spill.cmi : asmcomp/mach.cmi
 asmcomp/split.cmi : asmcomp/mach.cmi
 asmcomp/strmatch.cmi : asmcomp/cmm.cmi
+asmcomp/CSE.cmo : asmcomp/mach.cmi asmcomp/CSEgen.cmi asmcomp/arch.cmo
+asmcomp/CSE.cmx : asmcomp/mach.cmx asmcomp/CSEgen.cmx asmcomp/arch.cmx
+asmcomp/CSEgen.cmo : asmcomp/reg.cmi asmcomp/mach.cmi asmcomp/CSEgen.cmi
+asmcomp/CSEgen.cmx : asmcomp/reg.cmx asmcomp/mach.cmx asmcomp/CSEgen.cmi
 asmcomp/arch.cmo :
 asmcomp/arch.cmx :
 asmcomp/asmgen.cmo : bytecomp/translmod.cmi asmcomp/split.cmi \
@@ -625,20 +633,20 @@ asmcomp/asmgen.cmo : bytecomp/translmod.cmi asmcomp/split.cmi \
     asmcomp/printlinear.cmi asmcomp/printcmm.cmi asmcomp/printclambda.cmi \
     typing/primitive.cmi utils/misc.cmi asmcomp/mach.cmi parsing/location.cmi \
     asmcomp/liveness.cmi asmcomp/linearize.cmi asmcomp/interf.cmi \
-    asmcomp/emitaux.cmi asmcomp/emit.cmi utils/config.cmi \
-    asmcomp/compilenv.cmi asmcomp/comballoc.cmi asmcomp/coloring.cmi \
-    asmcomp/cmmgen.cmi asmcomp/cmm.cmi asmcomp/closure.cmi utils/clflags.cmi \
-    asmcomp/asmgen.cmi
+    asmcomp/emitaux.cmi asmcomp/emit.cmi asmcomp/deadcode.cmi \
+    utils/config.cmi asmcomp/compilenv.cmi asmcomp/comballoc.cmi \
+    asmcomp/coloring.cmi asmcomp/cmmgen.cmi asmcomp/cmm.cmi \
+    asmcomp/closure.cmi utils/clflags.cmi asmcomp/CSE.cmo asmcomp/asmgen.cmi
 asmcomp/asmgen.cmx : bytecomp/translmod.cmx asmcomp/split.cmx \
     asmcomp/spill.cmx asmcomp/selection.cmx asmcomp/scheduling.cmx \
     asmcomp/reload.cmx asmcomp/reg.cmx asmcomp/proc.cmx asmcomp/printmach.cmx \
     asmcomp/printlinear.cmx asmcomp/printcmm.cmx asmcomp/printclambda.cmx \
     typing/primitive.cmx utils/misc.cmx asmcomp/mach.cmx parsing/location.cmx \
     asmcomp/liveness.cmx asmcomp/linearize.cmx asmcomp/interf.cmx \
-    asmcomp/emitaux.cmx asmcomp/emit.cmx utils/config.cmx \
-    asmcomp/compilenv.cmx asmcomp/comballoc.cmx asmcomp/coloring.cmx \
-    asmcomp/cmmgen.cmx asmcomp/cmm.cmx asmcomp/closure.cmx utils/clflags.cmx \
-    asmcomp/asmgen.cmi
+    asmcomp/emitaux.cmx asmcomp/emit.cmx asmcomp/deadcode.cmx \
+    utils/config.cmx asmcomp/compilenv.cmx asmcomp/comballoc.cmx \
+    asmcomp/coloring.cmx asmcomp/cmmgen.cmx asmcomp/cmm.cmx \
+    asmcomp/closure.cmx utils/clflags.cmx asmcomp/CSE.cmx asmcomp/asmgen.cmi
 asmcomp/asmlibrarian.cmo : utils/misc.cmi parsing/location.cmi \
     utils/config.cmi asmcomp/compilenv.cmi asmcomp/cmx_format.cmi \
     utils/clflags.cmi asmcomp/clambda.cmi utils/ccomp.cmi asmcomp/asmlink.cmi \
@@ -719,6 +727,10 @@ asmcomp/compilenv.cmo : utils/misc.cmi parsing/location.cmi typing/ident.cmi \
 asmcomp/compilenv.cmx : utils/misc.cmx parsing/location.cmx typing/ident.cmx \
     typing/env.cmx utils/config.cmx asmcomp/cmx_format.cmi \
     asmcomp/clambda.cmx asmcomp/compilenv.cmi
+asmcomp/deadcode.cmo : asmcomp/reg.cmi asmcomp/proc.cmi asmcomp/mach.cmi \
+    asmcomp/deadcode.cmi
+asmcomp/deadcode.cmx : asmcomp/reg.cmx asmcomp/proc.cmx asmcomp/mach.cmx \
+    asmcomp/deadcode.cmi
 asmcomp/debuginfo.cmo : parsing/location.cmi bytecomp/lambda.cmi \
     asmcomp/debuginfo.cmi
 asmcomp/debuginfo.cmx : parsing/location.cmx bytecomp/lambda.cmx \
@@ -852,7 +864,8 @@ driver/compile.cmo : utils/warnings.cmi typing/typemod.cmi \
     parsing/printast.cmi parsing/pprintast.cmi driver/pparse.cmi \
     utils/misc.cmi parsing/location.cmi typing/includemod.cmi typing/env.cmi \
     bytecomp/emitcode.cmi driver/compmisc.cmi driver/compenv.cmi \
-    utils/clflags.cmi utils/ccomp.cmi bytecomp/bytegen.cmi driver/compile.cmi
+    utils/clflags.cmi utils/ccomp.cmi bytecomp/bytegen.cmi \
+    parsing/ast_mapper.cmi driver/compile.cmi
 driver/compile.cmx : utils/warnings.cmx typing/typemod.cmx \
     typing/typedtree.cmx typing/typecore.cmx bytecomp/translmod.cmx \
     typing/stypes.cmx bytecomp/simplif.cmx typing/printtyped.cmx \
@@ -860,11 +873,16 @@ driver/compile.cmx : utils/warnings.cmx typing/typemod.cmx \
     parsing/printast.cmx parsing/pprintast.cmx driver/pparse.cmx \
     utils/misc.cmx parsing/location.cmx typing/includemod.cmx typing/env.cmx \
     bytecomp/emitcode.cmx driver/compmisc.cmx driver/compenv.cmx \
-    utils/clflags.cmx utils/ccomp.cmx bytecomp/bytegen.cmx driver/compile.cmi
-driver/compmisc.cmo : utils/misc.cmi typing/ident.cmi typing/env.cmi \
-    utils/config.cmi driver/compenv.cmi utils/clflags.cmi driver/compmisc.cmi
-driver/compmisc.cmx : utils/misc.cmx typing/ident.cmx typing/env.cmx \
-    utils/config.cmx driver/compenv.cmx utils/clflags.cmx driver/compmisc.cmi
+    utils/clflags.cmx utils/ccomp.cmx bytecomp/bytegen.cmx \
+    parsing/ast_mapper.cmx driver/compile.cmi
+driver/compmisc.cmo : typing/typemod.cmi utils/misc.cmi \
+    parsing/longident.cmi parsing/location.cmi typing/ident.cmi \
+    typing/env.cmi utils/config.cmi driver/compenv.cmi utils/clflags.cmi \
+    parsing/asttypes.cmi driver/compmisc.cmi
+driver/compmisc.cmx : typing/typemod.cmx utils/misc.cmx \
+    parsing/longident.cmx parsing/location.cmx typing/ident.cmx \
+    typing/env.cmx utils/config.cmx driver/compenv.cmx utils/clflags.cmx \
+    parsing/asttypes.cmi driver/compmisc.cmi
 driver/errors.cmo : parsing/location.cmi driver/errors.cmi
 driver/errors.cmx : parsing/location.cmx driver/errors.cmi
 driver/main.cmo : utils/warnings.cmi utils/misc.cmi driver/main_args.cmi \
@@ -886,7 +904,8 @@ driver/optcompile.cmo : utils/warnings.cmi typing/typemod.cmi \
     parsing/pprintast.cmi driver/pparse.cmi utils/misc.cmi \
     typing/includemod.cmi typing/env.cmi utils/config.cmi driver/compmisc.cmi \
     asmcomp/compilenv.cmi driver/compenv.cmi utils/clflags.cmi \
-    utils/ccomp.cmi asmcomp/asmgen.cmi driver/optcompile.cmi
+    utils/ccomp.cmi parsing/ast_mapper.cmi asmcomp/asmgen.cmi \
+    driver/optcompile.cmi
 driver/optcompile.cmx : utils/warnings.cmx typing/typemod.cmx \
     typing/typedtree.cmx typing/typecore.cmx bytecomp/translmod.cmx \
     typing/stypes.cmx bytecomp/simplif.cmx typing/printtyped.cmx \
@@ -894,7 +913,8 @@ driver/optcompile.cmx : utils/warnings.cmx typing/typemod.cmx \
     parsing/pprintast.cmx driver/pparse.cmx utils/misc.cmx \
     typing/includemod.cmx typing/env.cmx utils/config.cmx driver/compmisc.cmx \
     asmcomp/compilenv.cmx driver/compenv.cmx utils/clflags.cmx \
-    utils/ccomp.cmx asmcomp/asmgen.cmx driver/optcompile.cmi
+    utils/ccomp.cmx parsing/ast_mapper.cmx asmcomp/asmgen.cmx \
+    driver/optcompile.cmi
 driver/opterrors.cmo : parsing/location.cmi driver/opterrors.cmi
 driver/opterrors.cmx : parsing/location.cmx driver/opterrors.cmi
 driver/optmain.cmo : utils/warnings.cmi asmcomp/printmach.cmi \
@@ -909,10 +929,14 @@ driver/optmain.cmx : utils/warnings.cmx asmcomp/printmach.cmx \
     driver/compenv.cmx utils/clflags.cmx asmcomp/asmpackager.cmx \
     asmcomp/asmlink.cmx asmcomp/asmlibrarian.cmx asmcomp/arch.cmx \
     driver/optmain.cmi
-driver/pparse.cmo : parsing/parse.cmi utils/misc.cmi parsing/location.cmi \
-    utils/config.cmi utils/clflags.cmi utils/ccomp.cmi driver/pparse.cmi
-driver/pparse.cmx : parsing/parse.cmx utils/misc.cmx parsing/location.cmx \
-    utils/config.cmx utils/clflags.cmx utils/ccomp.cmx driver/pparse.cmi
+driver/pparse.cmo : parsing/parsetree.cmi parsing/parse.cmi utils/misc.cmi \
+    parsing/longident.cmi parsing/location.cmi utils/config.cmi \
+    utils/clflags.cmi utils/ccomp.cmi parsing/asttypes.cmi \
+    parsing/ast_mapper.cmi parsing/ast_helper.cmi driver/pparse.cmi
+driver/pparse.cmx : parsing/parsetree.cmi parsing/parse.cmx utils/misc.cmx \
+    parsing/longident.cmx parsing/location.cmx utils/config.cmx \
+    utils/clflags.cmx utils/ccomp.cmx parsing/asttypes.cmi \
+    parsing/ast_mapper.cmx parsing/ast_helper.cmx driver/pparse.cmi
 toplevel/genprintval.cmi : typing/types.cmi typing/path.cmi \
     typing/outcometree.cmi typing/env.cmi
 toplevel/opttopdirs.cmi : parsing/longident.cmi
@@ -976,25 +1000,31 @@ toplevel/opttoploop.cmx : utils/warnings.cmx typing/types.cmx \
 toplevel/opttopmain.cmo : utils/warnings.cmi asmcomp/printmach.cmi \
     toplevel/opttoploop.cmi toplevel/opttopdirs.cmi utils/misc.cmi \
     driver/main_args.cmi parsing/location.cmi utils/config.cmi \
-    driver/compenv.cmi utils/clflags.cmi toplevel/opttopmain.cmi
+    driver/compenv.cmi utils/clflags.cmi parsing/ast_mapper.cmi \
+    toplevel/opttopmain.cmi
 toplevel/opttopmain.cmx : utils/warnings.cmx asmcomp/printmach.cmx \
     toplevel/opttoploop.cmx toplevel/opttopdirs.cmx utils/misc.cmx \
     driver/main_args.cmx parsing/location.cmx utils/config.cmx \
-    driver/compenv.cmx utils/clflags.cmx toplevel/opttopmain.cmi
+    driver/compenv.cmx utils/clflags.cmx parsing/ast_mapper.cmx \
+    toplevel/opttopmain.cmi
 toplevel/opttopstart.cmo : toplevel/opttopmain.cmi
 toplevel/opttopstart.cmx : toplevel/opttopmain.cmx
-toplevel/topdirs.cmo : utils/warnings.cmi typing/types.cmi \
-    toplevel/trace.cmi toplevel/toploop.cmi bytecomp/symtable.cmi \
-    typing/printtyp.cmi typing/path.cmi bytecomp/opcodes.cmo utils/misc.cmi \
-    bytecomp/meta.cmi parsing/longident.cmi typing/ident.cmi typing/env.cmi \
-    bytecomp/dll.cmi typing/ctype.cmi utils/consistbl.cmi utils/config.cmi \
-    bytecomp/cmo_format.cmi utils/clflags.cmi toplevel/topdirs.cmi
-toplevel/topdirs.cmx : utils/warnings.cmx typing/types.cmx \
-    toplevel/trace.cmx toplevel/toploop.cmx bytecomp/symtable.cmx \
-    typing/printtyp.cmx typing/path.cmx bytecomp/opcodes.cmx utils/misc.cmx \
-    bytecomp/meta.cmx parsing/longident.cmx typing/ident.cmx typing/env.cmx \
-    bytecomp/dll.cmx typing/ctype.cmx utils/consistbl.cmx utils/config.cmx \
-    bytecomp/cmo_format.cmi utils/clflags.cmx toplevel/topdirs.cmi
+toplevel/topdirs.cmo : utils/warnings.cmi typing/typetexp.cmi \
+    typing/types.cmi toplevel/trace.cmi toplevel/toploop.cmi \
+    bytecomp/symtable.cmi typing/printtyp.cmi typing/predef.cmi \
+    typing/path.cmi bytecomp/opcodes.cmo utils/misc.cmi bytecomp/meta.cmi \
+    parsing/longident.cmi parsing/location.cmi typing/ident.cmi \
+    typing/env.cmi bytecomp/dll.cmi typing/ctype.cmi utils/consistbl.cmi \
+    utils/config.cmi bytecomp/cmo_format.cmi utils/clflags.cmi \
+    parsing/asttypes.cmi toplevel/topdirs.cmi
+toplevel/topdirs.cmx : utils/warnings.cmx typing/typetexp.cmx \
+    typing/types.cmx toplevel/trace.cmx toplevel/toploop.cmx \
+    bytecomp/symtable.cmx typing/printtyp.cmx typing/predef.cmx \
+    typing/path.cmx bytecomp/opcodes.cmx utils/misc.cmx bytecomp/meta.cmx \
+    parsing/longident.cmx parsing/location.cmx typing/ident.cmx \
+    typing/env.cmx bytecomp/dll.cmx typing/ctype.cmx utils/consistbl.cmx \
+    utils/config.cmx bytecomp/cmo_format.cmi utils/clflags.cmx \
+    parsing/asttypes.cmi toplevel/topdirs.cmi
 toplevel/toploop.cmo : utils/warnings.cmi typing/types.cmi \
     typing/typemod.cmi typing/typedtree.cmi typing/typecore.cmi \
     bytecomp/translmod.cmi bytecomp/symtable.cmi bytecomp/simplif.cmi \
@@ -1026,11 +1056,11 @@ toplevel/toploop.cmx : utils/warnings.cmx typing/types.cmx \
 toplevel/topmain.cmo : utils/warnings.cmi toplevel/toploop.cmi \
     toplevel/topdirs.cmi utils/misc.cmi driver/main_args.cmi \
     parsing/location.cmi utils/config.cmi driver/compenv.cmi \
-    utils/clflags.cmi toplevel/topmain.cmi
+    utils/clflags.cmi parsing/ast_mapper.cmi toplevel/topmain.cmi
 toplevel/topmain.cmx : utils/warnings.cmx toplevel/toploop.cmx \
     toplevel/topdirs.cmx utils/misc.cmx driver/main_args.cmx \
     parsing/location.cmx utils/config.cmx driver/compenv.cmx \
-    utils/clflags.cmx toplevel/topmain.cmi
+    utils/clflags.cmx parsing/ast_mapper.cmx toplevel/topmain.cmi
 toplevel/topstart.cmo : toplevel/topmain.cmi
 toplevel/topstart.cmx : toplevel/topmain.cmx
 toplevel/trace.cmo : typing/types.cmi toplevel/toploop.cmi \
diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000000..2817041cf7
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,2590 @@
+# This file has been automatically generated using `git svn show-ignore > .gitignore`
+# from trunk@14716 (Thu May 1 09:28:35 2014).
+# Do not hesitate to refresh it from time to time.
+
+# /
+/*.o
+/*.a
+/*.so
+/*.obj
+/*.lib
+/*.dll
+/*.cm[ioxat]
+/*.cmx[as]
+/*.cmti
+/*.annot
+/*.result
+/*.byte
+/*.native
+/program
+/*.exe
+/*.exe.manifest
+/.depend
+/.depend.nt
+/.DS_Store
+/configure
+/ocamlc
+/ocamlc.opt
+/expunge
+/ocaml
+/ocamlopt
+/ocamlopt.opt
+/ocamlcomp.sh
+/ocamlcompopt.sh
+/package-macosx
+/ocamlnat
+
+# /asmcomp/
+/asmcomp/*.o
+/asmcomp/*.a
+/asmcomp/*.so
+/asmcomp/*.obj
+/asmcomp/*.lib
+/asmcomp/*.dll
+/asmcomp/*.cm[ioxat]
+/asmcomp/*.cmx[as]
+/asmcomp/*.cmti
+/asmcomp/*.annot
+/asmcomp/*.result
+/asmcomp/*.byte
+/asmcomp/*.native
+/asmcomp/program
+/asmcomp/*.exe
+/asmcomp/*.exe.manifest
+/asmcomp/.depend
+/asmcomp/.depend.nt
+/asmcomp/.DS_Store
+/asmcomp/emit.ml
+/asmcomp/arch.ml
+/asmcomp/proc.ml
+/asmcomp/selection.ml
+/asmcomp/reload.ml
+/asmcomp/scheduling.ml
+/asmcomp/CSE.ml
+
+# /asmcomp/amd64/
+/asmcomp/amd64/*.o
+/asmcomp/amd64/*.a
+/asmcomp/amd64/*.so
+/asmcomp/amd64/*.obj
+/asmcomp/amd64/*.cm[ioxat]
+/asmcomp/amd64/*.cmx[as]
+/asmcomp/amd64/*.cmti
+/asmcomp/amd64/*.annot
+/asmcomp/amd64/*.result
+/asmcomp/amd64/*.byte
+/asmcomp/amd64/*.native
+/asmcomp/amd64/program
+/asmcomp/amd64/program.exe
+/asmcomp/amd64/.depend
+/asmcomp/amd64/.depend.nt
+/asmcomp/amd64/.DS_Store
+
+# /asmrun/
+/asmrun/*.o
+/asmrun/*.a
+/asmrun/*.so
+/asmrun/*.obj
+/asmrun/*.lib
+/asmrun/*.dll
+/asmrun/*.cm[ioxat]
+/asmrun/*.cmx[as]
+/asmrun/*.cmti
+/asmrun/*.annot
+/asmrun/*.result
+/asmrun/*.byte
+/asmrun/*.native
+/asmrun/program
+/asmrun/*.exe
+/asmrun/.depend
+/asmrun/.depend.nt
+/asmrun/.DS_Store
+/asmrun/*.p.c
+/asmrun/*.d.c
+/asmrun/libasmrun.a
+/asmrun/libasmrunp.a
+/asmrun/main.c
+/asmrun/misc.c
+/asmrun/freelist.c
+/asmrun/major_gc.c
+/asmrun/minor_gc.c
+/asmrun/memory.c
+/asmrun/alloc.c
+/asmrun/array.c
+/asmrun/compare.c
+/asmrun/ints.c
+/asmrun/floats.c
+/asmrun/str.c
+/asmrun/io.c
+/asmrun/extern.c
+/asmrun/intern.c
+/asmrun/hash.c
+/asmrun/sys.c
+/asmrun/parsing.c
+/asmrun/gc_ctrl.c
+/asmrun/terminfo.c
+/asmrun/md5.c
+/asmrun/obj.c
+/asmrun/lexing.c
+/asmrun/printexc.c
+/asmrun/callback.c
+/asmrun/weak.c
+/asmrun/compact.c
+/asmrun/finalise.c
+/asmrun/custom.c
+/asmrun/meta.c
+/asmrun/globroots.c
+/asmrun/unix.c
+/asmrun/dynlink.c
+/asmrun/signals.c
+/asmrun/debugger.c
+/asmrun/.depend.nt
+
+# /boot/
+/boot/*.o
+/boot/*.a
+/boot/*.so
+/boot/*.obj
+/boot/*.lib
+/boot/*.dll
+/boot/*.cm[ioxat]
+/boot/*.cmx[as]
+/boot/*.cmti
+/boot/*.annot
+/boot/*.result
+/boot/*.byte
+/boot/*.native
+/boot/program
+/boot/*.exe
+/boot/*.exe.manifest
+/boot/.depend
+/boot/.depend.nt
+/boot/.DS_Store
+/boot/Saved
+/boot/ocamlrun
+/boot/ocamlrun.exe
+/boot/ocamlyacc
+/boot/ocamlyacc.exe
+/boot/camlheader
+
+# /bytecomp/
+/bytecomp/*.o
+/bytecomp/*.a
+/bytecomp/*.so
+/bytecomp/*.obj
+/bytecomp/*.lib
+/bytecomp/*.dll
+/bytecomp/*.cm[ioxat]
+/bytecomp/*.cmx[as]
+/bytecomp/*.cmti
+/bytecomp/*.annot
+/bytecomp/*.result
+/bytecomp/*.byte
+/bytecomp/*.native
+/bytecomp/program
+/bytecomp/*.exe
+/bytecomp/.depend
+/bytecomp/.depend.nt
+/bytecomp/.DS_Store
+/bytecomp/runtimedef.ml
+/bytecomp/opcodes.ml
+
+# /byterun/
+/byterun/*.o
+/byterun/*.a
+/byterun/*.so
+/byterun/*.obj
+/byterun/*.cm[ioxa]
+/byterun/*.cmx[as]
+/byterun/*.annot
+/byterun/*.result
+/byterun/*.byte
+/byterun/*.native
+/byterun/program
+/byterun/program.exe
+/byterun/.depend
+/byterun/.depend.nt
+/byterun/.DS_Store
+/byterun/jumptbl.h
+/byterun/primitives
+/byterun/prims.c
+/byterun/opnames.h
+/byterun/version.h
+/byterun/ocamlrun
+/byterun/ocamlrun.exe
+/byterun/ocamlrund
+/byterun/ocamlrund.exe
+/byterun/ld.conf
+/byterun/interp.a.lst
+/byterun/*.[sd]obj
+/byterun/*.lib
+/byterun/.gdb_history
+/byterun/*.d.c
+/byterun/*.pic.c
+
+# /compilerlibs/
+/compilerlibs/*
+
+# /config/
+/config/*.o
+/config/*.a
+/config/*.so
+/config/*.obj
+/config/*.lib
+/config/*.dll
+/config/*.cm[ioxat]
+/config/*.cmx[as]
+/config/*.cmti
+/config/*.annot
+/config/*.result
+/config/*.byte
+/config/*.native
+/config/program
+/config/*.exe
+/config/*.exe.manifest
+/config/.depend
+/config/.depend.nt
+/config/.DS_Store
+/config/m.h
+/config/s.h
+/config/Makefile
+
+# /config/auto-aux/
+/config/auto-aux/*.o
+/config/auto-aux/*.a
+/config/auto-aux/*.so
+/config/auto-aux/*.obj
+/config/auto-aux/*.cm[ioxa]
+/config/auto-aux/*.cmx[as]
+/config/auto-aux/*.annot
+/config/auto-aux/*.result
+/config/auto-aux/*.byte
+/config/auto-aux/*.native
+/config/auto-aux/program
+/config/auto-aux/.depend
+/config/auto-aux/.depend.nt
+/config/auto-aux/.DS_Store
+/config/auto-aux/camlp4_config.ml
+
+# /config/gnu/
+
+# /debugger/
+/debugger/*.o
+/debugger/*.a
+/debugger/*.so
+/debugger/*.obj
+/debugger/*.cm[ioxa]
+/debugger/*.cmx[as]
+/debugger/*.annot
+/debugger/*.result
+/debugger/*.byte
+/debugger/*.native
+/debugger/program
+/debugger/program.exe
+/debugger/.depend
+/debugger/.depend.nt
+/debugger/.DS_Store
+/debugger/lexer.ml
+/debugger/parser.ml
+/debugger/parser.mli
+/debugger/ocamldebug
+/debugger/ocamldebug.exe
+/debugger/dynlink.ml
+/debugger/dynlink.mli
+
+# /driver/
+/driver/*.o
+/driver/*.a
+/driver/*.so
+/driver/*.obj
+/driver/*.lib
+/driver/*.dll
+/driver/*.cm[ioxat]
+/driver/*.cmx[as]
+/driver/*.cmti
+/driver/*.annot
+/driver/*.result
+/driver/*.byte
+/driver/*.native
+/driver/program
+/driver/*.exe
+/driver/*.exe.manifest
+/driver/.depend
+/driver/.depend.nt
+/driver/.DS_Store
+
+# /emacs/
+/emacs/*.o
+/emacs/*.a
+/emacs/*.so
+/emacs/*.obj
+/emacs/*.lib
+/emacs/*.dll
+/emacs/*.cm[ioxat]
+/emacs/*.cmx[as]
+/emacs/*.cmti
+/emacs/*.annot
+/emacs/*.result
+/emacs/*.byte
+/emacs/*.native
+/emacs/program
+/emacs/*.exe
+/emacs/*.exe.manifest
+/emacs/.depend
+/emacs/.depend.nt
+/emacs/.DS_Store
+/emacs/ocamltags
+/emacs/*.elc
+
+# /experimental/
+
+# /experimental/garrigue/
+/experimental/garrigue/*.out
+/experimental/garrigue/*.out2
+
+# /lex/
+/lex/*.o
+/lex/*.a
+/lex/*.so
+/lex/*.obj
+/lex/*.lib
+/lex/*.dll
+/lex/*.cm[ioxat]
+/lex/*.cmx[as]
+/lex/*.cmti
+/lex/*.annot
+/lex/*.result
+/lex/*.byte
+/lex/*.native
+/lex/program
+/lex/*.exe
+/lex/*.exe.manifest
+/lex/.depend
+/lex/.depend.nt
+/lex/.DS_Store
+/lex/parser.ml
+/lex/parser.mli
+/lex/lexer.ml
+/lex/ocamllex
+/lex/ocamllex.opt
+/lex/parser.output
+
+# /ocamlbuild/
+/ocamlbuild/*.o
+/ocamlbuild/*.a
+/ocamlbuild/*.so
+/ocamlbuild/*.obj
+/ocamlbuild/*.lib
+/ocamlbuild/*.dll
+/ocamlbuild/*.cm[ioxat]
+/ocamlbuild/*.cmx[as]
+/ocamlbuild/*.cmti
+/ocamlbuild/*.annot
+/ocamlbuild/*.byte
+/ocamlbuild/*.native
+/ocamlbuild/ocamlbuild_config.ml
+/ocamlbuild/lexers.ml
+/ocamlbuild/glob_lexer.ml
+
+# /ocamldoc/
+/ocamldoc/*.o
+/ocamldoc/*.a
+/ocamldoc/*.so
+/ocamldoc/*.obj
+/ocamldoc/*.lib
+/ocamldoc/*.dll
+/ocamldoc/*.cm[ioxat]
+/ocamldoc/*.cmx[as]
+/ocamldoc/*.cmti
+/ocamldoc/*.annot
+/ocamldoc/*.result
+/ocamldoc/*.byte
+/ocamldoc/*.native
+/ocamldoc/program
+/ocamldoc/*.exe
+/ocamldoc/.depend
+/ocamldoc/.depend.nt
+/ocamldoc/.DS_Store
+/ocamldoc/ocamldoc
+/ocamldoc/ocamldoc.opt
+/ocamldoc/odoc_crc.ml
+/ocamldoc/odoc_lexer.ml
+/ocamldoc/odoc_ocamlhtml.ml
+/ocamldoc/odoc_parser.ml
+/ocamldoc/odoc_parser.mli
+/ocamldoc/odoc_see_lexer.ml
+/ocamldoc/odoc_text_lexer.ml
+/ocamldoc/odoc_text_parser.ml
+/ocamldoc/odoc_text_parser.mli
+/ocamldoc/stdlib_man
+/ocamldoc/*.output
+/ocamldoc/test_stdlib
+/ocamldoc/test_latex
+/ocamldoc/test
+
+# /ocamldoc/generators/
+/ocamldoc/generators/*.o
+/ocamldoc/generators/*.a
+/ocamldoc/generators/*.so
+/ocamldoc/generators/*.obj
+/ocamldoc/generators/*.lib
+/ocamldoc/generators/*.dll
+/ocamldoc/generators/*.cm[ioxat]
+/ocamldoc/generators/*.cmx[as]
+/ocamldoc/generators/*.cmti
+/ocamldoc/generators/*.annot
+/ocamldoc/generators/*.result
+/ocamldoc/generators/*.byte
+/ocamldoc/generators/*.native
+/ocamldoc/generators/program
+/ocamldoc/generators/*.exe
+/ocamldoc/generators/*.exe.manifest
+/ocamldoc/generators/.depend
+/ocamldoc/generators/.depend.nt
+/ocamldoc/generators/.DS_Store
+
+# /otherlibs/
+/otherlibs/.depend
+/otherlibs/configure
+/otherlibs/ocamlc
+/otherlibs/ocamlc.opt
+/otherlibs/expunge
+/otherlibs/ocaml
+/otherlibs/ocamlopt
+/otherlibs/ocamlopt.opt
+/otherlibs/ocamlcomp.sh
+/otherlibs/ocamlcompopt.sh
+/otherlibs/package-macosx
+/otherlibs/.DS_Store
+/otherlibs/*.annot
+/otherlibs/_boot_log1
+/otherlibs/_boot_log2
+/otherlibs/_build
+/otherlibs/_log
+/otherlibs/myocamlbuild_config.ml
+/otherlibs/ocamlnat
+/otherlibs/*.cm*
+/otherlibs/*.o
+
+# /otherlibs/bigarray/
+/otherlibs/bigarray/*.o
+/otherlibs/bigarray/*.a
+/otherlibs/bigarray/*.so
+/otherlibs/bigarray/*.obj
+/otherlibs/bigarray/*.lib
+/otherlibs/bigarray/*.dll
+/otherlibs/bigarray/*.cm[ioxat]
+/otherlibs/bigarray/*.cmx[as]
+/otherlibs/bigarray/*.cmti
+/otherlibs/bigarray/*.annot
+/otherlibs/bigarray/*.result
+/otherlibs/bigarray/*.byte
+/otherlibs/bigarray/*.native
+/otherlibs/bigarray/program
+/otherlibs/bigarray/*.exe
+/otherlibs/bigarray/.depend
+/otherlibs/bigarray/.depend.nt
+/otherlibs/bigarray/.DS_Store
+
+# /otherlibs/dynlink/
+/otherlibs/dynlink/*.o
+/otherlibs/dynlink/*.a
+/otherlibs/dynlink/*.so
+/otherlibs/dynlink/*.obj
+/otherlibs/dynlink/*.lib
+/otherlibs/dynlink/*.dll
+/otherlibs/dynlink/*.cm[ioxat]
+/otherlibs/dynlink/*.cmx[as]
+/otherlibs/dynlink/*.cmti
+/otherlibs/dynlink/*.annot
+/otherlibs/dynlink/*.result
+/otherlibs/dynlink/*.byte
+/otherlibs/dynlink/*.native
+/otherlibs/dynlink/program
+/otherlibs/dynlink/*.exe
+/otherlibs/dynlink/.depend
+/otherlibs/dynlink/.depend.nt
+/otherlibs/dynlink/.DS_Store
+/otherlibs/dynlink/extract_crc
+
+# /otherlibs/graph/
+/otherlibs/graph/*.o
+/otherlibs/graph/*.a
+/otherlibs/graph/*.so
+/otherlibs/graph/*.obj
+/otherlibs/graph/*.lib
+/otherlibs/graph/*.dll
+/otherlibs/graph/*.cm[ioxat]
+/otherlibs/graph/*.cmx[as]
+/otherlibs/graph/*.cmti
+/otherlibs/graph/*.annot
+/otherlibs/graph/*.result
+/otherlibs/graph/*.byte
+/otherlibs/graph/*.native
+/otherlibs/graph/program
+/otherlibs/graph/*.exe
+/otherlibs/graph/*.exe.manifest
+/otherlibs/graph/.depend
+/otherlibs/graph/.depend.nt
+/otherlibs/graph/.DS_Store
+
+# /otherlibs/num/
+/otherlibs/num/*.o
+/otherlibs/num/*.a
+/otherlibs/num/*.so
+/otherlibs/num/*.obj
+/otherlibs/num/*.lib
+/otherlibs/num/*.dll
+/otherlibs/num/*.cm[ioxat]
+/otherlibs/num/*.cmx[as]
+/otherlibs/num/*.cmti
+/otherlibs/num/*.annot
+/otherlibs/num/*.result
+/otherlibs/num/*.byte
+/otherlibs/num/*.native
+/otherlibs/num/program
+/otherlibs/num/*.exe
+/otherlibs/num/.depend
+/otherlibs/num/.depend.nt
+/otherlibs/num/.DS_Store
+
+# /otherlibs/str/
+/otherlibs/str/*.o
+/otherlibs/str/*.a
+/otherlibs/str/*.so
+/otherlibs/str/*.obj
+/otherlibs/str/*.lib
+/otherlibs/str/*.dll
+/otherlibs/str/*.cm[ioxat]
+/otherlibs/str/*.cmx[as]
+/otherlibs/str/*.cmti
+/otherlibs/str/*.annot
+/otherlibs/str/*.result
+/otherlibs/str/*.byte
+/otherlibs/str/*.native
+/otherlibs/str/program
+/otherlibs/str/*.exe
+/otherlibs/str/.depend
+/otherlibs/str/.depend.nt
+/otherlibs/str/.DS_Store
+
+# /otherlibs/systhreads/
+/otherlibs/systhreads/*.o
+/otherlibs/systhreads/*.a
+/otherlibs/systhreads/*.so
+/otherlibs/systhreads/*.obj
+/otherlibs/systhreads/*.lib
+/otherlibs/systhreads/*.dll
+/otherlibs/systhreads/*.cm[ioxat]
+/otherlibs/systhreads/*.cmx[as]
+/otherlibs/systhreads/*.cmti
+/otherlibs/systhreads/*.annot
+/otherlibs/systhreads/*.result
+/otherlibs/systhreads/*.byte
+/otherlibs/systhreads/*.native
+/otherlibs/systhreads/program
+/otherlibs/systhreads/*.exe
+/otherlibs/systhreads/.depend
+/otherlibs/systhreads/.depend.nt
+/otherlibs/systhreads/.DS_Store
+/otherlibs/systhreads/thread.ml
+
+# /otherlibs/threads/
+/otherlibs/threads/*.o
+/otherlibs/threads/*.a
+/otherlibs/threads/*.so
+/otherlibs/threads/*.obj
+/otherlibs/threads/*.lib
+/otherlibs/threads/*.dll
+/otherlibs/threads/*.cm[ioxat]
+/otherlibs/threads/*.cmx[as]
+/otherlibs/threads/*.cmti
+/otherlibs/threads/*.annot
+/otherlibs/threads/*.result
+/otherlibs/threads/*.byte
+/otherlibs/threads/*.native
+/otherlibs/threads/program
+/otherlibs/threads/*.exe
+/otherlibs/threads/*.exe.manifest
+/otherlibs/threads/.depend
+/otherlibs/threads/.depend.nt
+/otherlibs/threads/.DS_Store
+/otherlibs/threads/marshal.mli
+/otherlibs/threads/pervasives.mli
+/otherlibs/threads/unix.mli
+
+# /otherlibs/unix/
+/otherlibs/unix/*.o
+/otherlibs/unix/*.a
+/otherlibs/unix/*.so
+/otherlibs/unix/*.obj
+/otherlibs/unix/*.lib
+/otherlibs/unix/*.dll
+/otherlibs/unix/*.cm[ioxat]
+/otherlibs/unix/*.cmx[as]
+/otherlibs/unix/*.cmti
+/otherlibs/unix/*.annot
+/otherlibs/unix/*.result
+/otherlibs/unix/*.byte
+/otherlibs/unix/*.native
+/otherlibs/unix/program
+/otherlibs/unix/*.exe
+/otherlibs/unix/*.exe.manifest
+/otherlibs/unix/.depend
+/otherlibs/unix/.depend.nt
+/otherlibs/unix/.DS_Store
+
+# /otherlibs/win32graph/
+/otherlibs/win32graph/*.o
+/otherlibs/win32graph/*.a
+/otherlibs/win32graph/*.so
+/otherlibs/win32graph/*.obj
+/otherlibs/win32graph/*.lib
+/otherlibs/win32graph/*.dll
+/otherlibs/win32graph/*.cm[ioxat]
+/otherlibs/win32graph/*.cmx[as]
+/otherlibs/win32graph/*.cmti
+/otherlibs/win32graph/*.annot
+/otherlibs/win32graph/*.result
+/otherlibs/win32graph/*.byte
+/otherlibs/win32graph/*.native
+/otherlibs/win32graph/program
+/otherlibs/win32graph/*.exe
+/otherlibs/win32graph/.depend
+/otherlibs/win32graph/.depend.nt
+/otherlibs/win32graph/.DS_Store
+/otherlibs/win32graph/graphics.ml
+/otherlibs/win32graph/graphics.mli
+
+# /otherlibs/win32unix/
+/otherlibs/win32unix/*.o
+/otherlibs/win32unix/*.a
+/otherlibs/win32unix/*.so
+/otherlibs/win32unix/*.obj
+/otherlibs/win32unix/*.lib
+/otherlibs/win32unix/*.dll
+/otherlibs/win32unix/*.cm[ioxat]
+/otherlibs/win32unix/*.cmx[as]
+/otherlibs/win32unix/*.cmti
+/otherlibs/win32unix/*.annot
+/otherlibs/win32unix/*.result
+/otherlibs/win32unix/*.byte
+/otherlibs/win32unix/*.native
+/otherlibs/win32unix/program
+/otherlibs/win32unix/*.exe
+/otherlibs/win32unix/.depend
+/otherlibs/win32unix/.depend.nt
+/otherlibs/win32unix/.DS_Store
+/otherlibs/win32unix/unixLabels.ml*
+/otherlibs/win32unix/unix.mli
+/otherlibs/win32unix/unix.lib
+/otherlibs/win32unix/access.c
+/otherlibs/win32unix/addrofstr.c
+/otherlibs/win32unix/chdir.c
+/otherlibs/win32unix/chmod.c
+/otherlibs/win32unix/cst2constr.c
+/otherlibs/win32unix/cstringv.c
+/otherlibs/win32unix/envir.c
+/otherlibs/win32unix/execv.c
+/otherlibs/win32unix/execve.c
+/otherlibs/win32unix/execvp.c
+/otherlibs/win32unix/exit.c
+/otherlibs/win32unix/getaddrinfo.c
+/otherlibs/win32unix/getcwd.c
+/otherlibs/win32unix/gethost.c
+/otherlibs/win32unix/gethostname.c
+/otherlibs/win32unix/getnameinfo.c
+/otherlibs/win32unix/getproto.c
+/otherlibs/win32unix/getserv.c
+/otherlibs/win32unix/gmtime.c
+/otherlibs/win32unix/putenv.c
+/otherlibs/win32unix/rmdir.c
+/otherlibs/win32unix/socketaddr.c
+/otherlibs/win32unix/strofaddr.c
+/otherlibs/win32unix/time.c
+/otherlibs/win32unix/unlink.c
+/otherlibs/win32unix/utimes.c
+
+# /parsing/
+/parsing/*.o
+/parsing/*.a
+/parsing/*.so
+/parsing/*.obj
+/parsing/*.lib
+/parsing/*.dll
+/parsing/*.cm[ioxat]
+/parsing/*.cmx[as]
+/parsing/*.cmti
+/parsing/*.annot
+/parsing/*.result
+/parsing/*.byte
+/parsing/*.native
+/parsing/program
+/parsing/*.exe
+/parsing/*.exe.manifest
+/parsing/.depend
+/parsing/.depend.nt
+/parsing/.DS_Store
+/parsing/parser.ml
+/parsing/parser.mli
+/parsing/lexer.ml
+/parsing/lexer_tmp.mll
+/parsing/lexer_tmp.ml
+/parsing/linenum.ml
+/parsing/parser.output
+/parsing/parser.automaton
+/parsing/parser.conflicts
+
+# /stdlib/
+/stdlib/*.o
+/stdlib/*.a
+/stdlib/*.so
+/stdlib/*.obj
+/stdlib/*.lib
+/stdlib/*.dll
+/stdlib/*.cm[ioxat]
+/stdlib/*.cmx[as]
+/stdlib/*.cmti
+/stdlib/*.annot
+/stdlib/*.result
+/stdlib/*.byte
+/stdlib/*.native
+/stdlib/program
+/stdlib/*.exe
+/stdlib/.depend
+/stdlib/.depend.nt
+/stdlib/.DS_Store
+/stdlib/camlheader
+/stdlib/camlheaderd
+/stdlib/camlheader_ur
+/stdlib/labelled-*
+/stdlib/caml
+/stdlib/sys.ml
+
+# /testsuite/
+/testsuite/*.o
+/testsuite/*.a
+/testsuite/*.so
+/testsuite/*.obj
+/testsuite/*.cm[ioxa]
+/testsuite/*.cmx[as]
+/testsuite/*.annot
+/testsuite/*.result
+/testsuite/*.byte
+/testsuite/*.native
+/testsuite/program
+/testsuite/.depend
+/testsuite/.depend.nt
+/testsuite/.DS_Store
+/testsuite/_log
+
+# /testsuite/external/
+/testsuite/external/*.o
+/testsuite/external/*.a
+/testsuite/external/*.so
+/testsuite/external/*.obj
+/testsuite/external/*.lib
+/testsuite/external/*.dll
+/testsuite/external/*.cm[ioxat]
+/testsuite/external/*.cmx[as]
+/testsuite/external/*.cmti
+/testsuite/external/*.annot
+/testsuite/external/*.result
+/testsuite/external/*.byte
+/testsuite/external/*.native
+/testsuite/external/program
+/testsuite/external/*.exe
+/testsuite/external/*.exe.manifest
+/testsuite/external/.depend
+/testsuite/external/.depend.nt
+/testsuite/external/.DS_Store
+/testsuite/external/*.tar.gz
+/testsuite/external/*.tar.bz2
+/testsuite/external/*.tgz
+/testsuite/external/*.tbz
+/testsuite/external/*.zip
+/testsuite/external/log-*
+/testsuite/external/log_*
+/testsuite/external/advi
+/testsuite/external/advi-1.10.2
+/testsuite/external/altergo
+/testsuite/external/alt-ergo-0.95.2
+/testsuite/external/binprot
+/testsuite/external/bin_prot-109.30.00
+/testsuite/external/bitstring
+/testsuite/external/ocaml-bitstring-2.0.3
+/testsuite/external/boomerang
+/testsuite/external/boomerang-0.2
+/testsuite/external/calendar
+/testsuite/external/calendar-2.03.2
+/testsuite/external/camlimages
+/testsuite/external/camlimages-4.0.1
+/testsuite/external/camlpdf
+/testsuite/external/camlpdf-0.5
+/testsuite/external/camlp4
+/testsuite/external/camlp4-trunk
+/testsuite/external/camlp5
+/testsuite/external/camlp5-git
+/testsuite/external/camlzip
+/testsuite/external/camlzip-1.04
+/testsuite/external/camomile
+/testsuite/external/camomile-0.8.4
+/testsuite/external/comparelib
+/testsuite/external/comparelib-109.15.00
+/testsuite/external/compcert
+/testsuite/external/compcert-1.13
+/testsuite/external/configfile
+/testsuite/external/config-file-1.1
+/testsuite/external/coq
+/testsuite/external/coq-8.4pl2
+/testsuite/external/core
+/testsuite/external/core-109.37.00
+/testsuite/external/coreextended
+/testsuite/external/core_extended-109.36.00
+/testsuite/external/corekernel
+/testsuite/external/core_kernel-109.37.00
+/testsuite/external/cryptokit
+/testsuite/external/cryptokit-1.6
+/testsuite/external/csv
+/testsuite/external/csv-1.3.1
+/testsuite/external/customprintf
+/testsuite/external/custom_printf-109.27.00
+/testsuite/external/dbm
+/testsuite/external/camldbm-1.0
+/testsuite/external/expect
+/testsuite/external/ocaml-expect-0.0.3
+/testsuite/external/extlib
+/testsuite/external/extlib-1.5.2
+/testsuite/external/fieldslib
+/testsuite/external/fieldslib-109.15.00
+/testsuite/external/fileutils
+/testsuite/external/ocaml-fileutils-0.4.4
+/testsuite/external/findlib
+/testsuite/external/findlib-1.4.1
+/testsuite/external/framac
+/testsuite/external/frama-c-Oxygen-20120901
+/testsuite/external/geneweb
+/testsuite/external/gw-6.05-src
+/testsuite/external/herelib
+/testsuite/external/herelib-109.35.00
+/testsuite/external/hevea
+/testsuite/external/hevea-2.09
+/testsuite/external/kaputt
+/testsuite/external/kaputt-1.2
+/testsuite/external/lablgtk
+/testsuite/external/lablgtk-2.18.0
+/testsuite/external/lablgtkextras
+/testsuite/external/lablgtkextras-1.3
+/testsuite/external/lwt
+/testsuite/external/lwt-2.4.0
+/testsuite/external/menhir
+/testsuite/external/menhir-20120123
+/testsuite/external/mldonkey
+/testsuite/external/mldonkey-3.1.2
+/testsuite/external/mysql
+/testsuite/external/ocaml-mysql-1.0.4
+/testsuite/external/oasis
+/testsuite/external/oasis-0.3.0
+/testsuite/external/obrowser
+/testsuite/external/obrowser-1.1.1
+/testsuite/external/ocamlgraph
+/testsuite/external/ocamlgraph-1.8.2
+/testsuite/external/ocamlify
+/testsuite/external/ocamlify-0.0.1
+/testsuite/external/ocamlmod
+/testsuite/external/ocamlmod-0.0.3
+/testsuite/external/ocamlnet
+/testsuite/external/ocamlnet-3.5.1
+/testsuite/external/ocamlscript
+/testsuite/external/ocamlscript-2.0.3
+/testsuite/external/ocamlssl
+/testsuite/external/ocaml-ssl-0.4.6
+/testsuite/external/ocamltext
+/testsuite/external/ocaml-text-0.5
+/testsuite/external/ocgi
+/testsuite/external/ocgi-0.5
+/testsuite/external/ocsigen
+/testsuite/external/ocsigen-bundle-2.2.2
+/testsuite/external/odn
+/testsuite/external/ocaml-data-notation-0.0.10
+/testsuite/external/omake
+/testsuite/external/omake-0.9.8.6
+/testsuite/external/ounit
+/testsuite/external/ounit-1.1.2
+/testsuite/external/paounit
+/testsuite/external/pa_ounit-109.36.00
+/testsuite/external/pcre
+/testsuite/external/pcre-ocaml-6.2.5
+/testsuite/external/pipebang
+/testsuite/external/pipebang-109.28.00
+/testsuite/external/react
+/testsuite/external/react-0.9.3
+/testsuite/external/res
+/testsuite/external/res-3.2.0
+/testsuite/external/rss
+/testsuite/external/ocamlrss-2.2.2
+/testsuite/external/sexplib
+/testsuite/external/sexplib-109.15.00
+/testsuite/external/sks
+/testsuite/external/sks-1.1.3
+/testsuite/external/sqlite
+/testsuite/external/sqlite3-ocaml-2.0.1
+/testsuite/external/textutils
+/testsuite/external/textutils-109.36.00
+/testsuite/external/typeconv
+/testsuite/external/type_conv-109.28.00
+/testsuite/external/unison
+/testsuite/external/unison-2.45.4
+/testsuite/external/variantslib
+/testsuite/external/variantslib-109.15.00
+/testsuite/external/vsyml
+/testsuite/external/vsyml-2010-04-06
+/testsuite/external/xmllight
+/testsuite/external/xml-light.2.3
+/testsuite/external/xmlm
+/testsuite/external/xmlm-1.1.0
+/testsuite/external/zarith
+/testsuite/external/zarith-1.2.1
+/testsuite/external/zen
+/testsuite/external/zen_2.3.2
+/testsuite/external/._ZEN_2.3.2
+
+# /testsuite/interactive/
+/testsuite/interactive/# svn propset -R svn:ignore -F .svnignore .
+/testsuite/interactive/# find . -name .svnignore -print | while read f; do svn propset svn:ignore -F $f `dirname $f`; done
+/testsuite/interactive/_log
+/testsuite/interactive/*.so
+/testsuite/interactive/*.a
+/testsuite/interactive/*.result
+/testsuite/interactive/*.byte
+/testsuite/interactive/*.native
+/testsuite/interactive/program
+/testsuite/interactive/*.cm*
+/testsuite/interactive/*.o
+
+# /testsuite/interactive/lib-gc/
+/testsuite/interactive/lib-gc/# svn propset -R svn:ignore -F .svnignore .
+/testsuite/interactive/lib-gc/# find . -name .svnignore -print | while read f; do svn propset svn:ignore -F $f `dirname $f`; done
+/testsuite/interactive/lib-gc/_log
+/testsuite/interactive/lib-gc/*.so
+/testsuite/interactive/lib-gc/*.a
+/testsuite/interactive/lib-gc/*.result
+/testsuite/interactive/lib-gc/*.byte
+/testsuite/interactive/lib-gc/*.native
+/testsuite/interactive/lib-gc/program
+/testsuite/interactive/lib-gc/*.cm*
+/testsuite/interactive/lib-gc/*.o
+
+# /testsuite/interactive/lib-graph/
+/testsuite/interactive/lib-graph/# svn propset -R svn:ignore -F .svnignore .
+/testsuite/interactive/lib-graph/# find . -name .svnignore -print | while read f; do svn propset svn:ignore -F $f `dirname $f`; done
+/testsuite/interactive/lib-graph/_log
+/testsuite/interactive/lib-graph/*.so
+/testsuite/interactive/lib-graph/*.a
+/testsuite/interactive/lib-graph/*.result
+/testsuite/interactive/lib-graph/*.byte
+/testsuite/interactive/lib-graph/*.native
+/testsuite/interactive/lib-graph/program
+/testsuite/interactive/lib-graph/*.cm*
+/testsuite/interactive/lib-graph/*.o
+
+# /testsuite/interactive/lib-graph-2/
+/testsuite/interactive/lib-graph-2/# svn propset -R svn:ignore -F .svnignore .
+/testsuite/interactive/lib-graph-2/# find . -name .svnignore -print | while read f; do svn propset svn:ignore -F $f `dirname $f`; done
+/testsuite/interactive/lib-graph-2/_log
+/testsuite/interactive/lib-graph-2/*.so
+/testsuite/interactive/lib-graph-2/*.a
+/testsuite/interactive/lib-graph-2/*.result
+/testsuite/interactive/lib-graph-2/*.byte
+/testsuite/interactive/lib-graph-2/*.native
+/testsuite/interactive/lib-graph-2/program
+/testsuite/interactive/lib-graph-2/*.cm*
+/testsuite/interactive/lib-graph-2/*.o
+
+# /testsuite/interactive/lib-graph-3/
+/testsuite/interactive/lib-graph-3/# svn propset -R svn:ignore -F .svnignore .
+/testsuite/interactive/lib-graph-3/# find . -name .svnignore -print | while read f; do svn propset svn:ignore -F $f `dirname $f`; done
+/testsuite/interactive/lib-graph-3/_log
+/testsuite/interactive/lib-graph-3/*.so
+/testsuite/interactive/lib-graph-3/*.a
+/testsuite/interactive/lib-graph-3/*.result
+/testsuite/interactive/lib-graph-3/*.byte
+/testsuite/interactive/lib-graph-3/*.native
+/testsuite/interactive/lib-graph-3/program
+/testsuite/interactive/lib-graph-3/*.cm*
+/testsuite/interactive/lib-graph-3/*.o
+
+# /testsuite/interactive/lib-signals/
+/testsuite/interactive/lib-signals/# svn propset -R svn:ignore -F .svnignore .
+/testsuite/interactive/lib-signals/# find . -name .svnignore -print | while read f; do svn propset svn:ignore -F $f `dirname $f`; done
+/testsuite/interactive/lib-signals/_log
+/testsuite/interactive/lib-signals/*.so
+/testsuite/interactive/lib-signals/*.a
+/testsuite/interactive/lib-signals/*.result
+/testsuite/interactive/lib-signals/*.byte
+/testsuite/interactive/lib-signals/*.native
+/testsuite/interactive/lib-signals/program
+/testsuite/interactive/lib-signals/*.cm*
+/testsuite/interactive/lib-signals/*.o
+
+# /testsuite/lib/
+/testsuite/lib/*.o
+/testsuite/lib/*.a
+/testsuite/lib/*.so
+/testsuite/lib/*.obj
+/testsuite/lib/*.dll
+/testsuite/lib/*.cm[ioxat]
+/testsuite/lib/*.cmx[as]
+/testsuite/lib/*.cmti
+/testsuite/lib/*.annot
+/testsuite/lib/*.result
+/testsuite/lib/*.byte
+/testsuite/lib/*.native
+/testsuite/lib/program
+/testsuite/lib/*.exe
+/testsuite/lib/.depend
+/testsuite/lib/.depend.nt
+/testsuite/lib/.DS_Store
+
+# /testsuite/makefiles/
+/testsuite/makefiles/# svn propset -R svn:ignore -F .svnignore .
+/testsuite/makefiles/# find . -name .svnignore -print | while read f; do svn propset svn:ignore -F $f `dirname $f`; done
+/testsuite/makefiles/_log
+/testsuite/makefiles/*.so
+/testsuite/makefiles/*.a
+/testsuite/makefiles/*.result
+/testsuite/makefiles/*.byte
+/testsuite/makefiles/*.native
+/testsuite/makefiles/program
+/testsuite/makefiles/*.cm*
+/testsuite/makefiles/*.o
+
+# /testsuite/tests/
+/testsuite/tests/# svn propset -R svn:ignore -F .svnignore .
+/testsuite/tests/# find . -name .svnignore -print | while read f; do svn propset svn:ignore -F $f `dirname $f`; done
+/testsuite/tests/_log
+/testsuite/tests/*.so
+/testsuite/tests/*.a
+/testsuite/tests/*.result
+/testsuite/tests/*.byte
+/testsuite/tests/*.native
+/testsuite/tests/program
+/testsuite/tests/*.cm*
+/testsuite/tests/*.o
+
+# /testsuite/tests/asmcomp/
+/testsuite/tests/asmcomp/*.o
+/testsuite/tests/asmcomp/*.a
+/testsuite/tests/asmcomp/*.so
+/testsuite/tests/asmcomp/*.obj
+/testsuite/tests/asmcomp/*.lib
+/testsuite/tests/asmcomp/*.dll
+/testsuite/tests/asmcomp/*.cm[ioxat]
+/testsuite/tests/asmcomp/*.cmx[as]
+/testsuite/tests/asmcomp/*.cmti
+/testsuite/tests/asmcomp/*.annot
+/testsuite/tests/asmcomp/*.result
+/testsuite/tests/asmcomp/*.byte
+/testsuite/tests/asmcomp/*.native
+/testsuite/tests/asmcomp/program
+/testsuite/tests/asmcomp/*.exe
+/testsuite/tests/asmcomp/*.exe.manifest
+/testsuite/tests/asmcomp/.depend
+/testsuite/tests/asmcomp/.depend.nt
+/testsuite/tests/asmcomp/.DS_Store
+/testsuite/tests/asmcomp/codegen
+/testsuite/tests/asmcomp/parsecmm.ml
+/testsuite/tests/asmcomp/parsecmm.mli
+/testsuite/tests/asmcomp/lexcmm.ml
+/testsuite/tests/asmcomp/*.s
+/testsuite/tests/asmcomp/*.out
+/testsuite/tests/asmcomp/*.out.dSYM
+
+# /testsuite/tests/backtrace/
+/testsuite/tests/backtrace/*.o
+/testsuite/tests/backtrace/*.a
+/testsuite/tests/backtrace/*.so
+/testsuite/tests/backtrace/*.obj
+/testsuite/tests/backtrace/*.lib
+/testsuite/tests/backtrace/*.dll
+/testsuite/tests/backtrace/*.cm[ioxat]
+/testsuite/tests/backtrace/*.cmx[as]
+/testsuite/tests/backtrace/*.cmti
+/testsuite/tests/backtrace/*.annot
+/testsuite/tests/backtrace/*.result
+/testsuite/tests/backtrace/*.byte
+/testsuite/tests/backtrace/*.native
+/testsuite/tests/backtrace/program
+/testsuite/tests/backtrace/*.exe
+/testsuite/tests/backtrace/*.exe.manifest
+/testsuite/tests/backtrace/.depend
+/testsuite/tests/backtrace/.depend.nt
+/testsuite/tests/backtrace/.DS_Store
+
+# /testsuite/tests/basic/
+/testsuite/tests/basic/*.o
+/testsuite/tests/basic/*.a
+/testsuite/tests/basic/*.so
+/testsuite/tests/basic/*.obj
+/testsuite/tests/basic/*.cm[ioxa]
+/testsuite/tests/basic/*.cmx[as]
+/testsuite/tests/basic/*.annot
+/testsuite/tests/basic/*.result
+/testsuite/tests/basic/*.byte
+/testsuite/tests/basic/*.native
+/testsuite/tests/basic/program
+/testsuite/tests/basic/program.exe
+/testsuite/tests/basic/.depend
+/testsuite/tests/basic/.depend.nt
+/testsuite/tests/basic/.DS_Store
+
+# /testsuite/tests/basic-float/
+/testsuite/tests/basic-float/*.o
+/testsuite/tests/basic-float/*.a
+/testsuite/tests/basic-float/*.so
+/testsuite/tests/basic-float/*.obj
+/testsuite/tests/basic-float/*.lib
+/testsuite/tests/basic-float/*.dll
+/testsuite/tests/basic-float/*.cm[ioxat]
+/testsuite/tests/basic-float/*.cmx[as]
+/testsuite/tests/basic-float/*.cmti
+/testsuite/tests/basic-float/*.annot
+/testsuite/tests/basic-float/*.result
+/testsuite/tests/basic-float/*.byte
+/testsuite/tests/basic-float/*.native
+/testsuite/tests/basic-float/program
+/testsuite/tests/basic-float/*.exe
+/testsuite/tests/basic-float/*.exe.manifest
+/testsuite/tests/basic-float/.depend
+/testsuite/tests/basic-float/.depend.nt
+/testsuite/tests/basic-float/.DS_Store
+
+# /testsuite/tests/basic-io/
+/testsuite/tests/basic-io/*.o
+/testsuite/tests/basic-io/*.a
+/testsuite/tests/basic-io/*.so
+/testsuite/tests/basic-io/*.obj
+/testsuite/tests/basic-io/*.lib
+/testsuite/tests/basic-io/*.dll
+/testsuite/tests/basic-io/*.cm[ioxat]
+/testsuite/tests/basic-io/*.cmx[as]
+/testsuite/tests/basic-io/*.cmti
+/testsuite/tests/basic-io/*.annot
+/testsuite/tests/basic-io/*.result
+/testsuite/tests/basic-io/*.byte
+/testsuite/tests/basic-io/*.native
+/testsuite/tests/basic-io/program
+/testsuite/tests/basic-io/*.exe
+/testsuite/tests/basic-io/*.exe.manifest
+/testsuite/tests/basic-io/.depend
+/testsuite/tests/basic-io/.depend.nt
+/testsuite/tests/basic-io/.DS_Store
+
+# /testsuite/tests/basic-io-2/
+/testsuite/tests/basic-io-2/*.o
+/testsuite/tests/basic-io-2/*.a
+/testsuite/tests/basic-io-2/*.so
+/testsuite/tests/basic-io-2/*.obj
+/testsuite/tests/basic-io-2/*.lib
+/testsuite/tests/basic-io-2/*.dll
+/testsuite/tests/basic-io-2/*.cm[ioxat]
+/testsuite/tests/basic-io-2/*.cmx[as]
+/testsuite/tests/basic-io-2/*.cmti
+/testsuite/tests/basic-io-2/*.annot
+/testsuite/tests/basic-io-2/*.result
+/testsuite/tests/basic-io-2/*.byte
+/testsuite/tests/basic-io-2/*.native
+/testsuite/tests/basic-io-2/program
+/testsuite/tests/basic-io-2/*.exe
+/testsuite/tests/basic-io-2/*.exe.manifest
+/testsuite/tests/basic-io-2/.depend
+/testsuite/tests/basic-io-2/.depend.nt
+/testsuite/tests/basic-io-2/.DS_Store
+
+# /testsuite/tests/basic-manyargs/
+/testsuite/tests/basic-manyargs/*.o
+/testsuite/tests/basic-manyargs/*.a
+/testsuite/tests/basic-manyargs/*.so
+/testsuite/tests/basic-manyargs/*.obj
+/testsuite/tests/basic-manyargs/*.lib
+/testsuite/tests/basic-manyargs/*.dll
+/testsuite/tests/basic-manyargs/*.cm[ioxat]
+/testsuite/tests/basic-manyargs/*.cmx[as]
+/testsuite/tests/basic-manyargs/*.cmti
+/testsuite/tests/basic-manyargs/*.annot
+/testsuite/tests/basic-manyargs/*.result
+/testsuite/tests/basic-manyargs/*.byte
+/testsuite/tests/basic-manyargs/*.native
+/testsuite/tests/basic-manyargs/program
+/testsuite/tests/basic-manyargs/*.exe
+/testsuite/tests/basic-manyargs/*.exe.manifest
+/testsuite/tests/basic-manyargs/.depend
+/testsuite/tests/basic-manyargs/.depend.nt
+/testsuite/tests/basic-manyargs/.DS_Store
+
+# /testsuite/tests/basic-more/
+/testsuite/tests/basic-more/*.o
+/testsuite/tests/basic-more/*.a
+/testsuite/tests/basic-more/*.so
+/testsuite/tests/basic-more/*.obj
+/testsuite/tests/basic-more/*.cm[ioxa]
+/testsuite/tests/basic-more/*.cmx[as]
+/testsuite/tests/basic-more/*.annot
+/testsuite/tests/basic-more/*.result
+/testsuite/tests/basic-more/*.byte
+/testsuite/tests/basic-more/*.native
+/testsuite/tests/basic-more/program
+/testsuite/tests/basic-more/program.exe
+/testsuite/tests/basic-more/.depend
+/testsuite/tests/basic-more/.depend.nt
+/testsuite/tests/basic-more/.DS_Store
+
+# /testsuite/tests/basic-multdef/
+/testsuite/tests/basic-multdef/*.o
+/testsuite/tests/basic-multdef/*.a
+/testsuite/tests/basic-multdef/*.so
+/testsuite/tests/basic-multdef/*.obj
+/testsuite/tests/basic-multdef/*.lib
+/testsuite/tests/basic-multdef/*.dll
+/testsuite/tests/basic-multdef/*.cm[ioxat]
+/testsuite/tests/basic-multdef/*.cmx[as]
+/testsuite/tests/basic-multdef/*.cmti
+/testsuite/tests/basic-multdef/*.annot
+/testsuite/tests/basic-multdef/*.result
+/testsuite/tests/basic-multdef/*.byte
+/testsuite/tests/basic-multdef/*.native
+/testsuite/tests/basic-multdef/program
+/testsuite/tests/basic-multdef/*.exe
+/testsuite/tests/basic-multdef/*.exe.manifest
+/testsuite/tests/basic-multdef/.depend
+/testsuite/tests/basic-multdef/.depend.nt
+/testsuite/tests/basic-multdef/.DS_Store
+
+# /testsuite/tests/basic-private/
+/testsuite/tests/basic-private/*.o
+/testsuite/tests/basic-private/*.a
+/testsuite/tests/basic-private/*.so
+/testsuite/tests/basic-private/*.obj
+/testsuite/tests/basic-private/*.lib
+/testsuite/tests/basic-private/*.dll
+/testsuite/tests/basic-private/*.cm[ioxat]
+/testsuite/tests/basic-private/*.cmx[as]
+/testsuite/tests/basic-private/*.cmti
+/testsuite/tests/basic-private/*.annot
+/testsuite/tests/basic-private/*.result
+/testsuite/tests/basic-private/*.byte
+/testsuite/tests/basic-private/*.native
+/testsuite/tests/basic-private/program
+/testsuite/tests/basic-private/*.exe
+/testsuite/tests/basic-private/*.exe.manifest
+/testsuite/tests/basic-private/.depend
+/testsuite/tests/basic-private/.depend.nt
+/testsuite/tests/basic-private/.DS_Store
+
+# /testsuite/tests/callback/
+/testsuite/tests/callback/*.o
+/testsuite/tests/callback/*.a
+/testsuite/tests/callback/*.so
+/testsuite/tests/callback/*.obj
+/testsuite/tests/callback/*.cm[ioxa]
+/testsuite/tests/callback/*.cmx[as]
+/testsuite/tests/callback/*.annot
+/testsuite/tests/callback/*.result
+/testsuite/tests/callback/*.byte
+/testsuite/tests/callback/*.native
+/testsuite/tests/callback/program
+/testsuite/tests/callback/program.exe
+/testsuite/tests/callback/.depend
+/testsuite/tests/callback/.depend.nt
+/testsuite/tests/callback/.DS_Store
+
+# /testsuite/tests/embedded/
+/testsuite/tests/embedded/*.o
+/testsuite/tests/embedded/*.a
+/testsuite/tests/embedded/*.so
+/testsuite/tests/embedded/*.obj
+/testsuite/tests/embedded/*.lib
+/testsuite/tests/embedded/*.dll
+/testsuite/tests/embedded/*.cm[ioxat]
+/testsuite/tests/embedded/*.cmx[as]
+/testsuite/tests/embedded/*.cmti
+/testsuite/tests/embedded/*.annot
+/testsuite/tests/embedded/*.result
+/testsuite/tests/embedded/*.byte
+/testsuite/tests/embedded/*.native
+/testsuite/tests/embedded/program
+/testsuite/tests/embedded/*.exe
+/testsuite/tests/embedded/*.exe.manifest
+/testsuite/tests/embedded/.depend
+/testsuite/tests/embedded/.depend.nt
+/testsuite/tests/embedded/.DS_Store
+/testsuite/tests/embedded/caml
+
+# /testsuite/tests/exotic-syntax/
+/testsuite/tests/exotic-syntax/*.o
+/testsuite/tests/exotic-syntax/*.a
+/testsuite/tests/exotic-syntax/*.so
+/testsuite/tests/exotic-syntax/*.obj
+/testsuite/tests/exotic-syntax/*.lib
+/testsuite/tests/exotic-syntax/*.dll
+/testsuite/tests/exotic-syntax/*.cm[ioxat]
+/testsuite/tests/exotic-syntax/*.cmx[as]
+/testsuite/tests/exotic-syntax/*.cmti
+/testsuite/tests/exotic-syntax/*.annot
+/testsuite/tests/exotic-syntax/*.result
+/testsuite/tests/exotic-syntax/*.byte
+/testsuite/tests/exotic-syntax/*.native
+/testsuite/tests/exotic-syntax/program
+/testsuite/tests/exotic-syntax/*.exe
+/testsuite/tests/exotic-syntax/*.exe.manifest
+/testsuite/tests/exotic-syntax/.depend
+/testsuite/tests/exotic-syntax/.depend.nt
+/testsuite/tests/exotic-syntax/.DS_Store
+
+# /testsuite/tests/gc-roots/
+/testsuite/tests/gc-roots/*.o
+/testsuite/tests/gc-roots/*.a
+/testsuite/tests/gc-roots/*.so
+/testsuite/tests/gc-roots/*.obj
+/testsuite/tests/gc-roots/*.lib
+/testsuite/tests/gc-roots/*.dll
+/testsuite/tests/gc-roots/*.cm[ioxat]
+/testsuite/tests/gc-roots/*.cmx[as]
+/testsuite/tests/gc-roots/*.cmti
+/testsuite/tests/gc-roots/*.annot
+/testsuite/tests/gc-roots/*.result
+/testsuite/tests/gc-roots/*.byte
+/testsuite/tests/gc-roots/*.native
+/testsuite/tests/gc-roots/program
+/testsuite/tests/gc-roots/*.exe
+/testsuite/tests/gc-roots/*.exe.manifest
+/testsuite/tests/gc-roots/.depend
+/testsuite/tests/gc-roots/.depend.nt
+/testsuite/tests/gc-roots/.DS_Store
+
+# /testsuite/tests/letrec/
+/testsuite/tests/letrec/*.o
+/testsuite/tests/letrec/*.a
+/testsuite/tests/letrec/*.so
+/testsuite/tests/letrec/*.obj
+/testsuite/tests/letrec/*.cm[ioxa]
+/testsuite/tests/letrec/*.cmx[as]
+/testsuite/tests/letrec/*.annot
+/testsuite/tests/letrec/*.result
+/testsuite/tests/letrec/*.byte
+/testsuite/tests/letrec/*.native
+/testsuite/tests/letrec/program
+/testsuite/tests/letrec/program.exe
+/testsuite/tests/letrec/.depend
+/testsuite/tests/letrec/.depend.nt
+/testsuite/tests/letrec/.DS_Store
+
+# /testsuite/tests/lib-bigarray/
+/testsuite/tests/lib-bigarray/*.o
+/testsuite/tests/lib-bigarray/*.a
+/testsuite/tests/lib-bigarray/*.so
+/testsuite/tests/lib-bigarray/*.obj
+/testsuite/tests/lib-bigarray/*.lib
+/testsuite/tests/lib-bigarray/*.dll
+/testsuite/tests/lib-bigarray/*.cm[ioxat]
+/testsuite/tests/lib-bigarray/*.cmx[as]
+/testsuite/tests/lib-bigarray/*.cmti
+/testsuite/tests/lib-bigarray/*.annot
+/testsuite/tests/lib-bigarray/*.result
+/testsuite/tests/lib-bigarray/*.byte
+/testsuite/tests/lib-bigarray/*.native
+/testsuite/tests/lib-bigarray/program
+/testsuite/tests/lib-bigarray/*.exe
+/testsuite/tests/lib-bigarray/*.exe.manifest
+/testsuite/tests/lib-bigarray/.depend
+/testsuite/tests/lib-bigarray/.depend.nt
+/testsuite/tests/lib-bigarray/.DS_Store
+
+# /testsuite/tests/lib-bigarray-2/
+/testsuite/tests/lib-bigarray-2/# svn propset -R svn:ignore -F .svnignore .
+/testsuite/tests/lib-bigarray-2/# find . -name .svnignore -print | while read f; do svn propset svn:ignore -F $f `dirname $f`; done
+/testsuite/tests/lib-bigarray-2/_log
+/testsuite/tests/lib-bigarray-2/*.so
+/testsuite/tests/lib-bigarray-2/*.a
+/testsuite/tests/lib-bigarray-2/*.result
+/testsuite/tests/lib-bigarray-2/*.byte
+/testsuite/tests/lib-bigarray-2/*.native
+/testsuite/tests/lib-bigarray-2/program
+/testsuite/tests/lib-bigarray-2/*.cm*
+/testsuite/tests/lib-bigarray-2/*.o
+
+# /testsuite/tests/lib-digest/
+/testsuite/tests/lib-digest/*.o
+/testsuite/tests/lib-digest/*.a
+/testsuite/tests/lib-digest/*.so
+/testsuite/tests/lib-digest/*.obj
+/testsuite/tests/lib-digest/*.lib
+/testsuite/tests/lib-digest/*.dll
+/testsuite/tests/lib-digest/*.cm[ioxat]
+/testsuite/tests/lib-digest/*.cmx[as]
+/testsuite/tests/lib-digest/*.cmti
+/testsuite/tests/lib-digest/*.annot
+/testsuite/tests/lib-digest/*.result
+/testsuite/tests/lib-digest/*.byte
+/testsuite/tests/lib-digest/*.native
+/testsuite/tests/lib-digest/program
+/testsuite/tests/lib-digest/*.exe
+/testsuite/tests/lib-digest/*.exe.manifest
+/testsuite/tests/lib-digest/.depend
+/testsuite/tests/lib-digest/.depend.nt
+/testsuite/tests/lib-digest/.DS_Store
+
+# /testsuite/tests/lib-dynlink-bytecode/
+/testsuite/tests/lib-dynlink-bytecode/*.o
+/testsuite/tests/lib-dynlink-bytecode/*.a
+/testsuite/tests/lib-dynlink-bytecode/*.so
+/testsuite/tests/lib-dynlink-bytecode/*.obj
+/testsuite/tests/lib-dynlink-bytecode/*.lib
+/testsuite/tests/lib-dynlink-bytecode/*.dll
+/testsuite/tests/lib-dynlink-bytecode/*.cm[ioxat]
+/testsuite/tests/lib-dynlink-bytecode/*.cmx[as]
+/testsuite/tests/lib-dynlink-bytecode/*.cmti
+/testsuite/tests/lib-dynlink-bytecode/*.annot
+/testsuite/tests/lib-dynlink-bytecode/*.result
+/testsuite/tests/lib-dynlink-bytecode/*.byte
+/testsuite/tests/lib-dynlink-bytecode/*.native
+/testsuite/tests/lib-dynlink-bytecode/program
+/testsuite/tests/lib-dynlink-bytecode/*.exe
+/testsuite/tests/lib-dynlink-bytecode/*.exe.manifest
+/testsuite/tests/lib-dynlink-bytecode/.depend
+/testsuite/tests/lib-dynlink-bytecode/.depend.nt
+/testsuite/tests/lib-dynlink-bytecode/.DS_Store
+/testsuite/tests/lib-dynlink-bytecode/main
+/testsuite/tests/lib-dynlink-bytecode/static
+/testsuite/tests/lib-dynlink-bytecode/custom
+/testsuite/tests/lib-dynlink-bytecode/custom.exe
+/testsuite/tests/lib-dynlink-bytecode/marshal.data
+/testsuite/tests/lib-dynlink-bytecode/caml
+
+# /testsuite/tests/lib-dynlink-csharp/
+/testsuite/tests/lib-dynlink-csharp/*.o
+/testsuite/tests/lib-dynlink-csharp/*.a
+/testsuite/tests/lib-dynlink-csharp/*.so
+/testsuite/tests/lib-dynlink-csharp/*.obj
+/testsuite/tests/lib-dynlink-csharp/*.lib
+/testsuite/tests/lib-dynlink-csharp/*.dll
+/testsuite/tests/lib-dynlink-csharp/*.cm[ioxat]
+/testsuite/tests/lib-dynlink-csharp/*.cmx[as]
+/testsuite/tests/lib-dynlink-csharp/*.cmti
+/testsuite/tests/lib-dynlink-csharp/*.annot
+/testsuite/tests/lib-dynlink-csharp/*.result
+/testsuite/tests/lib-dynlink-csharp/*.byte
+/testsuite/tests/lib-dynlink-csharp/*.native
+/testsuite/tests/lib-dynlink-csharp/program
+/testsuite/tests/lib-dynlink-csharp/*.exe
+/testsuite/tests/lib-dynlink-csharp/*.exe.manifest
+/testsuite/tests/lib-dynlink-csharp/.depend
+/testsuite/tests/lib-dynlink-csharp/.depend.nt
+/testsuite/tests/lib-dynlink-csharp/.DS_Store
+
+# /testsuite/tests/lib-dynlink-native/
+/testsuite/tests/lib-dynlink-native/*.o
+/testsuite/tests/lib-dynlink-native/*.a
+/testsuite/tests/lib-dynlink-native/*.so
+/testsuite/tests/lib-dynlink-native/*.obj
+/testsuite/tests/lib-dynlink-native/*.lib
+/testsuite/tests/lib-dynlink-native/*.dll
+/testsuite/tests/lib-dynlink-native/*.cm[ioxat]
+/testsuite/tests/lib-dynlink-native/*.cmx[as]
+/testsuite/tests/lib-dynlink-native/*.cmti
+/testsuite/tests/lib-dynlink-native/*.annot
+/testsuite/tests/lib-dynlink-native/*.result
+/testsuite/tests/lib-dynlink-native/*.byte
+/testsuite/tests/lib-dynlink-native/*.native
+/testsuite/tests/lib-dynlink-native/program
+/testsuite/tests/lib-dynlink-native/*.exe
+/testsuite/tests/lib-dynlink-native/*.exe.manifest
+/testsuite/tests/lib-dynlink-native/.depend
+/testsuite/tests/lib-dynlink-native/.depend.nt
+/testsuite/tests/lib-dynlink-native/.DS_Store
+/testsuite/tests/lib-dynlink-native/mypack.pack.s
+/testsuite/tests/lib-dynlink-native/mypack.pack.asm
+/testsuite/tests/lib-dynlink-native/result
+/testsuite/tests/lib-dynlink-native/main
+/testsuite/tests/lib-dynlink-native/main.exe
+/testsuite/tests/lib-dynlink-native/marshal.data
+/testsuite/tests/lib-dynlink-native/caml
+
+# /testsuite/tests/lib-dynlink-native/sub/
+/testsuite/tests/lib-dynlink-native/sub/*.o
+/testsuite/tests/lib-dynlink-native/sub/*.a
+/testsuite/tests/lib-dynlink-native/sub/*.so
+/testsuite/tests/lib-dynlink-native/sub/*.obj
+/testsuite/tests/lib-dynlink-native/sub/*.lib
+/testsuite/tests/lib-dynlink-native/sub/*.dll
+/testsuite/tests/lib-dynlink-native/sub/*.cm[ioxat]
+/testsuite/tests/lib-dynlink-native/sub/*.cmx[as]
+/testsuite/tests/lib-dynlink-native/sub/*.cmti
+/testsuite/tests/lib-dynlink-native/sub/*.annot
+/testsuite/tests/lib-dynlink-native/sub/*.result
+/testsuite/tests/lib-dynlink-native/sub/*.byte
+/testsuite/tests/lib-dynlink-native/sub/*.native
+/testsuite/tests/lib-dynlink-native/sub/program
+/testsuite/tests/lib-dynlink-native/sub/*.exe
+/testsuite/tests/lib-dynlink-native/sub/*.exe.manifest
+/testsuite/tests/lib-dynlink-native/sub/.depend
+/testsuite/tests/lib-dynlink-native/sub/.depend.nt
+/testsuite/tests/lib-dynlink-native/sub/.DS_Store
+
+# /testsuite/tests/lib-format/
+/testsuite/tests/lib-format/*.o
+/testsuite/tests/lib-format/*.a
+/testsuite/tests/lib-format/*.so
+/testsuite/tests/lib-format/*.obj
+/testsuite/tests/lib-format/*.lib
+/testsuite/tests/lib-format/*.dll
+/testsuite/tests/lib-format/*.cm[ioxat]
+/testsuite/tests/lib-format/*.cmx[as]
+/testsuite/tests/lib-format/*.cmti
+/testsuite/tests/lib-format/*.annot
+/testsuite/tests/lib-format/*.result
+/testsuite/tests/lib-format/*.byte
+/testsuite/tests/lib-format/*.native
+/testsuite/tests/lib-format/program
+/testsuite/tests/lib-format/*.exe
+/testsuite/tests/lib-format/*.exe.manifest
+/testsuite/tests/lib-format/.depend
+/testsuite/tests/lib-format/.depend.nt
+/testsuite/tests/lib-format/.DS_Store
+
+# /testsuite/tests/lib-hashtbl/
+/testsuite/tests/lib-hashtbl/*.o
+/testsuite/tests/lib-hashtbl/*.a
+/testsuite/tests/lib-hashtbl/*.so
+/testsuite/tests/lib-hashtbl/*.obj
+/testsuite/tests/lib-hashtbl/*.cm[ioxa]
+/testsuite/tests/lib-hashtbl/*.cmx[as]
+/testsuite/tests/lib-hashtbl/*.annot
+/testsuite/tests/lib-hashtbl/*.result
+/testsuite/tests/lib-hashtbl/*.byte
+/testsuite/tests/lib-hashtbl/*.native
+/testsuite/tests/lib-hashtbl/program
+/testsuite/tests/lib-hashtbl/program.exe
+/testsuite/tests/lib-hashtbl/.depend
+/testsuite/tests/lib-hashtbl/.depend.nt
+/testsuite/tests/lib-hashtbl/.DS_Store
+
+# /testsuite/tests/lib-marshal/
+/testsuite/tests/lib-marshal/*.o
+/testsuite/tests/lib-marshal/*.a
+/testsuite/tests/lib-marshal/*.so
+/testsuite/tests/lib-marshal/*.obj
+/testsuite/tests/lib-marshal/*.lib
+/testsuite/tests/lib-marshal/*.dll
+/testsuite/tests/lib-marshal/*.cm[ioxat]
+/testsuite/tests/lib-marshal/*.cmx[as]
+/testsuite/tests/lib-marshal/*.cmti
+/testsuite/tests/lib-marshal/*.annot
+/testsuite/tests/lib-marshal/*.result
+/testsuite/tests/lib-marshal/*.byte
+/testsuite/tests/lib-marshal/*.native
+/testsuite/tests/lib-marshal/program
+/testsuite/tests/lib-marshal/*.exe
+/testsuite/tests/lib-marshal/*.exe.manifest
+/testsuite/tests/lib-marshal/.depend
+/testsuite/tests/lib-marshal/.depend.nt
+/testsuite/tests/lib-marshal/.DS_Store
+
+# /testsuite/tests/lib-num/
+/testsuite/tests/lib-num/*.o
+/testsuite/tests/lib-num/*.a
+/testsuite/tests/lib-num/*.so
+/testsuite/tests/lib-num/*.obj
+/testsuite/tests/lib-num/*.lib
+/testsuite/tests/lib-num/*.dll
+/testsuite/tests/lib-num/*.cm[ioxat]
+/testsuite/tests/lib-num/*.cmx[as]
+/testsuite/tests/lib-num/*.cmti
+/testsuite/tests/lib-num/*.annot
+/testsuite/tests/lib-num/*.result
+/testsuite/tests/lib-num/*.byte
+/testsuite/tests/lib-num/*.native
+/testsuite/tests/lib-num/program
+/testsuite/tests/lib-num/*.exe
+/testsuite/tests/lib-num/*.exe.manifest
+/testsuite/tests/lib-num/.depend
+/testsuite/tests/lib-num/.depend.nt
+/testsuite/tests/lib-num/.DS_Store
+
+# /testsuite/tests/lib-num-2/
+/testsuite/tests/lib-num-2/*.o
+/testsuite/tests/lib-num-2/*.a
+/testsuite/tests/lib-num-2/*.so
+/testsuite/tests/lib-num-2/*.obj
+/testsuite/tests/lib-num-2/*.cm[ioxa]
+/testsuite/tests/lib-num-2/*.cmx[as]
+/testsuite/tests/lib-num-2/*.annot
+/testsuite/tests/lib-num-2/*.result
+/testsuite/tests/lib-num-2/*.byte
+/testsuite/tests/lib-num-2/*.native
+/testsuite/tests/lib-num-2/program
+/testsuite/tests/lib-num-2/program.exe
+/testsuite/tests/lib-num-2/.depend
+/testsuite/tests/lib-num-2/.depend.nt
+/testsuite/tests/lib-num-2/.DS_Store
+
+# /testsuite/tests/lib-printf/
+/testsuite/tests/lib-printf/*.o
+/testsuite/tests/lib-printf/*.a
+/testsuite/tests/lib-printf/*.so
+/testsuite/tests/lib-printf/*.obj
+/testsuite/tests/lib-printf/*.lib
+/testsuite/tests/lib-printf/*.dll
+/testsuite/tests/lib-printf/*.cm[ioxat]
+/testsuite/tests/lib-printf/*.cmx[as]
+/testsuite/tests/lib-printf/*.cmti
+/testsuite/tests/lib-printf/*.annot
+/testsuite/tests/lib-printf/*.result
+/testsuite/tests/lib-printf/*.byte
+/testsuite/tests/lib-printf/*.native
+/testsuite/tests/lib-printf/program
+/testsuite/tests/lib-printf/*.exe
+/testsuite/tests/lib-printf/*.exe.manifest
+/testsuite/tests/lib-printf/.depend
+/testsuite/tests/lib-printf/.depend.nt
+/testsuite/tests/lib-printf/.DS_Store
+
+# /testsuite/tests/lib-random/
+/testsuite/tests/lib-random/*.o
+/testsuite/tests/lib-random/*.a
+/testsuite/tests/lib-random/*.so
+/testsuite/tests/lib-random/*.obj
+/testsuite/tests/lib-random/*.lib
+/testsuite/tests/lib-random/*.dll
+/testsuite/tests/lib-random/*.cm[ioxat]
+/testsuite/tests/lib-random/*.cmx[as]
+/testsuite/tests/lib-random/*.cmti
+/testsuite/tests/lib-random/*.annot
+/testsuite/tests/lib-random/*.result
+/testsuite/tests/lib-random/*.byte
+/testsuite/tests/lib-random/*.native
+/testsuite/tests/lib-random/program
+/testsuite/tests/lib-random/*.exe
+/testsuite/tests/lib-random/*.exe.manifest
+/testsuite/tests/lib-random/.depend
+/testsuite/tests/lib-random/.depend.nt
+/testsuite/tests/lib-random/.DS_Store
+
+# /testsuite/tests/lib-scanf/
+/testsuite/tests/lib-scanf/*.o
+/testsuite/tests/lib-scanf/*.a
+/testsuite/tests/lib-scanf/*.so
+/testsuite/tests/lib-scanf/*.obj
+/testsuite/tests/lib-scanf/*.lib
+/testsuite/tests/lib-scanf/*.dll
+/testsuite/tests/lib-scanf/*.cm[ioxat]
+/testsuite/tests/lib-scanf/*.cmx[as]
+/testsuite/tests/lib-scanf/*.cmti
+/testsuite/tests/lib-scanf/*.annot
+/testsuite/tests/lib-scanf/*.result
+/testsuite/tests/lib-scanf/*.byte
+/testsuite/tests/lib-scanf/*.native
+/testsuite/tests/lib-scanf/program
+/testsuite/tests/lib-scanf/*.exe
+/testsuite/tests/lib-scanf/*.exe.manifest
+/testsuite/tests/lib-scanf/.depend
+/testsuite/tests/lib-scanf/.depend.nt
+/testsuite/tests/lib-scanf/.DS_Store
+/testsuite/tests/lib-scanf/tscanf_data
+
+# /testsuite/tests/lib-scanf-2/
+/testsuite/tests/lib-scanf-2/*.o
+/testsuite/tests/lib-scanf-2/*.a
+/testsuite/tests/lib-scanf-2/*.so
+/testsuite/tests/lib-scanf-2/*.obj
+/testsuite/tests/lib-scanf-2/*.lib
+/testsuite/tests/lib-scanf-2/*.dll
+/testsuite/tests/lib-scanf-2/*.cm[ioxat]
+/testsuite/tests/lib-scanf-2/*.cmx[as]
+/testsuite/tests/lib-scanf-2/*.cmti
+/testsuite/tests/lib-scanf-2/*.annot
+/testsuite/tests/lib-scanf-2/*.result
+/testsuite/tests/lib-scanf-2/*.byte
+/testsuite/tests/lib-scanf-2/*.native
+/testsuite/tests/lib-scanf-2/program
+/testsuite/tests/lib-scanf-2/*.exe
+/testsuite/tests/lib-scanf-2/*.exe.manifest
+/testsuite/tests/lib-scanf-2/.depend
+/testsuite/tests/lib-scanf-2/.depend.nt
+/testsuite/tests/lib-scanf-2/.DS_Store
+
+# /testsuite/tests/lib-set/
+/testsuite/tests/lib-set/*.o
+/testsuite/tests/lib-set/*.a
+/testsuite/tests/lib-set/*.so
+/testsuite/tests/lib-set/*.obj
+/testsuite/tests/lib-set/*.cm[ioxa]
+/testsuite/tests/lib-set/*.cmx[as]
+/testsuite/tests/lib-set/*.annot
+/testsuite/tests/lib-set/*.result
+/testsuite/tests/lib-set/*.byte
+/testsuite/tests/lib-set/*.native
+/testsuite/tests/lib-set/program
+/testsuite/tests/lib-set/program.exe
+/testsuite/tests/lib-set/.depend
+/testsuite/tests/lib-set/.depend.nt
+/testsuite/tests/lib-set/.DS_Store
+
+# /testsuite/tests/lib-str/
+/testsuite/tests/lib-str/*.o
+/testsuite/tests/lib-str/*.a
+/testsuite/tests/lib-str/*.so
+/testsuite/tests/lib-str/*.obj
+/testsuite/tests/lib-str/*.cm[ioxa]
+/testsuite/tests/lib-str/*.cmx[as]
+/testsuite/tests/lib-str/*.annot
+/testsuite/tests/lib-str/*.result
+/testsuite/tests/lib-str/*.byte
+/testsuite/tests/lib-str/*.native
+/testsuite/tests/lib-str/program
+/testsuite/tests/lib-str/program.exe
+/testsuite/tests/lib-str/.depend
+/testsuite/tests/lib-str/.depend.nt
+/testsuite/tests/lib-str/.DS_Store
+
+# /testsuite/tests/lib-stream/
+/testsuite/tests/lib-stream/*.o
+/testsuite/tests/lib-stream/*.a
+/testsuite/tests/lib-stream/*.so
+/testsuite/tests/lib-stream/*.obj
+/testsuite/tests/lib-stream/*.cm[ioxa]
+/testsuite/tests/lib-stream/*.cmx[as]
+/testsuite/tests/lib-stream/*.annot
+/testsuite/tests/lib-stream/*.result
+/testsuite/tests/lib-stream/*.byte
+/testsuite/tests/lib-stream/*.native
+/testsuite/tests/lib-stream/program
+/testsuite/tests/lib-stream/program.exe
+/testsuite/tests/lib-stream/.depend
+/testsuite/tests/lib-stream/.depend.nt
+/testsuite/tests/lib-stream/.DS_Store
+
+# /testsuite/tests/lib-systhreads/
+/testsuite/tests/lib-systhreads/*.o
+/testsuite/tests/lib-systhreads/*.a
+/testsuite/tests/lib-systhreads/*.so
+/testsuite/tests/lib-systhreads/*.obj
+/testsuite/tests/lib-systhreads/*.cm[ioxa]
+/testsuite/tests/lib-systhreads/*.cmx[as]
+/testsuite/tests/lib-systhreads/*.annot
+/testsuite/tests/lib-systhreads/*.result
+/testsuite/tests/lib-systhreads/*.byte
+/testsuite/tests/lib-systhreads/*.native
+/testsuite/tests/lib-systhreads/program
+/testsuite/tests/lib-systhreads/program.exe
+/testsuite/tests/lib-systhreads/.depend
+/testsuite/tests/lib-systhreads/.depend.nt
+/testsuite/tests/lib-systhreads/.DS_Store
+
+# /testsuite/tests/lib-threads/
+/testsuite/tests/lib-threads/*.o
+/testsuite/tests/lib-threads/*.a
+/testsuite/tests/lib-threads/*.so
+/testsuite/tests/lib-threads/*.obj
+/testsuite/tests/lib-threads/*.cm[ioxa]
+/testsuite/tests/lib-threads/*.cmx[as]
+/testsuite/tests/lib-threads/*.annot
+/testsuite/tests/lib-threads/*.result
+/testsuite/tests/lib-threads/*.byte
+/testsuite/tests/lib-threads/*.native
+/testsuite/tests/lib-threads/program
+/testsuite/tests/lib-threads/program.exe
+/testsuite/tests/lib-threads/.depend
+/testsuite/tests/lib-threads/.depend.nt
+/testsuite/tests/lib-threads/.DS_Store
+/testsuite/tests/lib-threads/*.byt
+
+# /testsuite/tests/misc/
+/testsuite/tests/misc/*.o
+/testsuite/tests/misc/*.a
+/testsuite/tests/misc/*.so
+/testsuite/tests/misc/*.obj
+/testsuite/tests/misc/*.cm[ioxa]
+/testsuite/tests/misc/*.cmx[as]
+/testsuite/tests/misc/*.annot
+/testsuite/tests/misc/*.result
+/testsuite/tests/misc/*.byte
+/testsuite/tests/misc/*.native
+/testsuite/tests/misc/program
+/testsuite/tests/misc/program.exe
+/testsuite/tests/misc/.depend
+/testsuite/tests/misc/.depend.nt
+/testsuite/tests/misc/.DS_Store
+
+# /testsuite/tests/misc-kb/
+/testsuite/tests/misc-kb/*.o
+/testsuite/tests/misc-kb/*.a
+/testsuite/tests/misc-kb/*.so
+/testsuite/tests/misc-kb/*.obj
+/testsuite/tests/misc-kb/*.lib
+/testsuite/tests/misc-kb/*.dll
+/testsuite/tests/misc-kb/*.cm[ioxat]
+/testsuite/tests/misc-kb/*.cmx[as]
+/testsuite/tests/misc-kb/*.cmti
+/testsuite/tests/misc-kb/*.annot
+/testsuite/tests/misc-kb/*.result
+/testsuite/tests/misc-kb/*.byte
+/testsuite/tests/misc-kb/*.native
+/testsuite/tests/misc-kb/program
+/testsuite/tests/misc-kb/*.exe
+/testsuite/tests/misc-kb/*.exe.manifest
+/testsuite/tests/misc-kb/.depend
+/testsuite/tests/misc-kb/.depend.nt
+/testsuite/tests/misc-kb/.DS_Store
+
+# /testsuite/tests/misc-unsafe/
+/testsuite/tests/misc-unsafe/*.o
+/testsuite/tests/misc-unsafe/*.a
+/testsuite/tests/misc-unsafe/*.so
+/testsuite/tests/misc-unsafe/*.obj
+/testsuite/tests/misc-unsafe/*.cm[ioxa]
+/testsuite/tests/misc-unsafe/*.cmx[as]
+/testsuite/tests/misc-unsafe/*.annot
+/testsuite/tests/misc-unsafe/*.result
+/testsuite/tests/misc-unsafe/*.byte
+/testsuite/tests/misc-unsafe/*.native
+/testsuite/tests/misc-unsafe/program
+/testsuite/tests/misc-unsafe/program.exe
+/testsuite/tests/misc-unsafe/.depend
+/testsuite/tests/misc-unsafe/.depend.nt
+/testsuite/tests/misc-unsafe/.DS_Store
+
+# /testsuite/tests/prim-bigstring/
+/testsuite/tests/prim-bigstring/*.o
+/testsuite/tests/prim-bigstring/*.a
+/testsuite/tests/prim-bigstring/*.so
+/testsuite/tests/prim-bigstring/*.obj
+/testsuite/tests/prim-bigstring/*.lib
+/testsuite/tests/prim-bigstring/*.dll
+/testsuite/tests/prim-bigstring/*.cm[ioxat]
+/testsuite/tests/prim-bigstring/*.cmx[as]
+/testsuite/tests/prim-bigstring/*.cmti
+/testsuite/tests/prim-bigstring/*.annot
+/testsuite/tests/prim-bigstring/*.result
+/testsuite/tests/prim-bigstring/*.byte
+/testsuite/tests/prim-bigstring/*.native
+/testsuite/tests/prim-bigstring/program
+/testsuite/tests/prim-bigstring/*.exe
+/testsuite/tests/prim-bigstring/*.exe.manifest
+/testsuite/tests/prim-bigstring/.depend
+/testsuite/tests/prim-bigstring/.depend.nt
+/testsuite/tests/prim-bigstring/.DS_Store
+
+# /testsuite/tests/prim-bswap/
+/testsuite/tests/prim-bswap/*.o
+/testsuite/tests/prim-bswap/*.a
+/testsuite/tests/prim-bswap/*.so
+/testsuite/tests/prim-bswap/*.obj
+/testsuite/tests/prim-bswap/*.cm[ioxat]
+/testsuite/tests/prim-bswap/*.cmx[as]
+/testsuite/tests/prim-bswap/*.cmti
+/testsuite/tests/prim-bswap/*.annot
+/testsuite/tests/prim-bswap/*.result
+/testsuite/tests/prim-bswap/*.byte
+/testsuite/tests/prim-bswap/*.native
+/testsuite/tests/prim-bswap/program
+/testsuite/tests/prim-bswap/program.exe
+/testsuite/tests/prim-bswap/.depend
+/testsuite/tests/prim-bswap/.depend.nt
+/testsuite/tests/prim-bswap/.DS_Store
+
+# /testsuite/tests/prim-revapply/
+/testsuite/tests/prim-revapply/*.o
+/testsuite/tests/prim-revapply/*.a
+/testsuite/tests/prim-revapply/*.so
+/testsuite/tests/prim-revapply/*.obj
+/testsuite/tests/prim-revapply/*.cm[ioxa]
+/testsuite/tests/prim-revapply/*.cmx[as]
+/testsuite/tests/prim-revapply/*.annot
+/testsuite/tests/prim-revapply/*.result
+/testsuite/tests/prim-revapply/*.byte
+/testsuite/tests/prim-revapply/*.native
+/testsuite/tests/prim-revapply/program
+/testsuite/tests/prim-revapply/program.exe
+/testsuite/tests/prim-revapply/.depend
+/testsuite/tests/prim-revapply/.depend.nt
+/testsuite/tests/prim-revapply/.DS_Store
+
+# /testsuite/tests/regression/pr5080-notes/
+/testsuite/tests/regression/pr5080-notes/*.o
+/testsuite/tests/regression/pr5080-notes/*.a
+/testsuite/tests/regression/pr5080-notes/*.so
+/testsuite/tests/regression/pr5080-notes/*.obj
+/testsuite/tests/regression/pr5080-notes/*.cm[ioxa]
+/testsuite/tests/regression/pr5080-notes/*.cmx[as]
+/testsuite/tests/regression/pr5080-notes/*.annot
+/testsuite/tests/regression/pr5080-notes/*.result
+/testsuite/tests/regression/pr5080-notes/*.byte
+/testsuite/tests/regression/pr5080-notes/*.native
+/testsuite/tests/regression/pr5080-notes/program
+/testsuite/tests/regression/pr5080-notes/program.exe
+/testsuite/tests/regression/pr5080-notes/.depend
+/testsuite/tests/regression/pr5080-notes/.depend.nt
+/testsuite/tests/regression/pr5080-notes/.DS_Store
+
+# /testsuite/tests/regression/pr5233/
+/testsuite/tests/regression/pr5233/*.o
+/testsuite/tests/regression/pr5233/*.a
+/testsuite/tests/regression/pr5233/*.so
+/testsuite/tests/regression/pr5233/*.obj
+/testsuite/tests/regression/pr5233/*.lib
+/testsuite/tests/regression/pr5233/*.dll
+/testsuite/tests/regression/pr5233/*.cm[ioxat]
+/testsuite/tests/regression/pr5233/*.cmx[as]
+/testsuite/tests/regression/pr5233/*.cmti
+/testsuite/tests/regression/pr5233/*.annot
+/testsuite/tests/regression/pr5233/*.result
+/testsuite/tests/regression/pr5233/*.byte
+/testsuite/tests/regression/pr5233/*.native
+/testsuite/tests/regression/pr5233/program
+/testsuite/tests/regression/pr5233/*.exe
+/testsuite/tests/regression/pr5233/*.exe.manifest
+/testsuite/tests/regression/pr5233/.depend
+/testsuite/tests/regression/pr5233/.depend.nt
+/testsuite/tests/regression/pr5233/.DS_Store
+
+# /testsuite/tests/regression/pr5757/
+/testsuite/tests/regression/pr5757/*.o
+/testsuite/tests/regression/pr5757/*.a
+/testsuite/tests/regression/pr5757/*.so
+/testsuite/tests/regression/pr5757/*.obj
+/testsuite/tests/regression/pr5757/*.lib
+/testsuite/tests/regression/pr5757/*.dll
+/testsuite/tests/regression/pr5757/*.cm[ioxat]
+/testsuite/tests/regression/pr5757/*.cmx[as]
+/testsuite/tests/regression/pr5757/*.cmti
+/testsuite/tests/regression/pr5757/*.annot
+/testsuite/tests/regression/pr5757/*.result
+/testsuite/tests/regression/pr5757/*.byte
+/testsuite/tests/regression/pr5757/*.native
+/testsuite/tests/regression/pr5757/program
+/testsuite/tests/regression/pr5757/*.exe
+/testsuite/tests/regression/pr5757/*.exe.manifest
+/testsuite/tests/regression/pr5757/.depend
+/testsuite/tests/regression/pr5757/.depend.nt
+/testsuite/tests/regression/pr5757/.DS_Store
+
+# /testsuite/tests/regression/pr6024/
+/testsuite/tests/regression/pr6024/*.o
+/testsuite/tests/regression/pr6024/*.a
+/testsuite/tests/regression/pr6024/*.so
+/testsuite/tests/regression/pr6024/*.obj
+/testsuite/tests/regression/pr6024/*.lib
+/testsuite/tests/regression/pr6024/*.dll
+/testsuite/tests/regression/pr6024/*.cm[ioxat]
+/testsuite/tests/regression/pr6024/*.cmx[as]
+/testsuite/tests/regression/pr6024/*.cmti
+/testsuite/tests/regression/pr6024/*.annot
+/testsuite/tests/regression/pr6024/*.result
+/testsuite/tests/regression/pr6024/*.byte
+/testsuite/tests/regression/pr6024/*.native
+/testsuite/tests/regression/pr6024/program
+/testsuite/tests/regression/pr6024/*.exe
+/testsuite/tests/regression/pr6024/*.exe.manifest
+/testsuite/tests/regression/pr6024/.depend
+/testsuite/tests/regression/pr6024/.depend.nt
+/testsuite/tests/regression/pr6024/.DS_Store
+
+# /testsuite/tests/runtime-errors/
+/testsuite/tests/runtime-errors/*.o
+/testsuite/tests/runtime-errors/*.a
+/testsuite/tests/runtime-errors/*.so
+/testsuite/tests/runtime-errors/*.obj
+/testsuite/tests/runtime-errors/*.lib
+/testsuite/tests/runtime-errors/*.dll
+/testsuite/tests/runtime-errors/*.cm[ioxat]
+/testsuite/tests/runtime-errors/*.cmx[as]
+/testsuite/tests/runtime-errors/*.cmti
+/testsuite/tests/runtime-errors/*.annot
+/testsuite/tests/runtime-errors/*.result
+/testsuite/tests/runtime-errors/*.byte
+/testsuite/tests/runtime-errors/*.native
+/testsuite/tests/runtime-errors/program
+/testsuite/tests/runtime-errors/*.exe
+/testsuite/tests/runtime-errors/*.exe.manifest
+/testsuite/tests/runtime-errors/.depend
+/testsuite/tests/runtime-errors/.depend.nt
+/testsuite/tests/runtime-errors/.DS_Store
+/testsuite/tests/runtime-errors/*.bytecode
+
+# /testsuite/tests/tool-debugger/
+/testsuite/tests/tool-debugger/*.o
+/testsuite/tests/tool-debugger/*.a
+/testsuite/tests/tool-debugger/*.so
+/testsuite/tests/tool-debugger/*.obj
+/testsuite/tests/tool-debugger/*.lib
+/testsuite/tests/tool-debugger/*.dll
+/testsuite/tests/tool-debugger/*.cm[ioxat]
+/testsuite/tests/tool-debugger/*.cmx[as]
+/testsuite/tests/tool-debugger/*.cmti
+/testsuite/tests/tool-debugger/*.annot
+/testsuite/tests/tool-debugger/*.result
+/testsuite/tests/tool-debugger/*.byte
+/testsuite/tests/tool-debugger/*.native
+/testsuite/tests/tool-debugger/program
+/testsuite/tests/tool-debugger/*.exe
+/testsuite/tests/tool-debugger/*.exe.manifest
+/testsuite/tests/tool-debugger/.depend
+/testsuite/tests/tool-debugger/.depend.nt
+/testsuite/tests/tool-debugger/.DS_Store
+/testsuite/tests/tool-debugger/compiler-libs
+
+# /testsuite/tests/tool-lexyacc/
+/testsuite/tests/tool-lexyacc/*.o
+/testsuite/tests/tool-lexyacc/*.a
+/testsuite/tests/tool-lexyacc/*.so
+/testsuite/tests/tool-lexyacc/*.obj
+/testsuite/tests/tool-lexyacc/*.lib
+/testsuite/tests/tool-lexyacc/*.dll
+/testsuite/tests/tool-lexyacc/*.cm[ioxat]
+/testsuite/tests/tool-lexyacc/*.cmx[as]
+/testsuite/tests/tool-lexyacc/*.cmti
+/testsuite/tests/tool-lexyacc/*.annot
+/testsuite/tests/tool-lexyacc/*.result
+/testsuite/tests/tool-lexyacc/*.byte
+/testsuite/tests/tool-lexyacc/*.native
+/testsuite/tests/tool-lexyacc/program
+/testsuite/tests/tool-lexyacc/*.exe
+/testsuite/tests/tool-lexyacc/*.exe.manifest
+/testsuite/tests/tool-lexyacc/.depend
+/testsuite/tests/tool-lexyacc/.depend.nt
+/testsuite/tests/tool-lexyacc/.DS_Store
+/testsuite/tests/tool-lexyacc/scanner.ml
+/testsuite/tests/tool-lexyacc/grammar.mli
+/testsuite/tests/tool-lexyacc/grammar.ml
+
+# /testsuite/tests/tool-ocaml/
+/testsuite/tests/tool-ocaml/# svn propset -R svn:ignore -F .svnignore .
+/testsuite/tests/tool-ocaml/# find . -name .svnignore -print | while read f; do svn propset svn:ignore -F $f `dirname $f`; done
+/testsuite/tests/tool-ocaml/_log
+/testsuite/tests/tool-ocaml/*.so
+/testsuite/tests/tool-ocaml/*.a
+/testsuite/tests/tool-ocaml/*.result
+/testsuite/tests/tool-ocaml/*.byte
+/testsuite/tests/tool-ocaml/*.native
+/testsuite/tests/tool-ocaml/program
+/testsuite/tests/tool-ocaml/*.cm*
+/testsuite/tests/tool-ocaml/*.o
+
+# /testsuite/tests/tool-ocamldoc/
+/testsuite/tests/tool-ocamldoc/*.o
+/testsuite/tests/tool-ocamldoc/*.a
+/testsuite/tests/tool-ocamldoc/*.so
+/testsuite/tests/tool-ocamldoc/*.obj
+/testsuite/tests/tool-ocamldoc/*.cm[ioxa]
+/testsuite/tests/tool-ocamldoc/*.cmx[as]
+/testsuite/tests/tool-ocamldoc/*.annot
+/testsuite/tests/tool-ocamldoc/*.result
+/testsuite/tests/tool-ocamldoc/*.byte
+/testsuite/tests/tool-ocamldoc/*.native
+/testsuite/tests/tool-ocamldoc/program
+/testsuite/tests/tool-ocamldoc/.depend
+/testsuite/tests/tool-ocamldoc/.depend.nt
+/testsuite/tests/tool-ocamldoc/.DS_Store
+/testsuite/tests/tool-ocamldoc/*.html
+/testsuite/tests/tool-ocamldoc/*.sty
+/testsuite/tests/tool-ocamldoc/*.css
+/testsuite/tests/tool-ocamldoc/ocamldoc.out
+
+# /testsuite/tests/typing-fstclassmod/
+/testsuite/tests/typing-fstclassmod/*.o
+/testsuite/tests/typing-fstclassmod/*.a
+/testsuite/tests/typing-fstclassmod/*.so
+/testsuite/tests/typing-fstclassmod/*.obj
+/testsuite/tests/typing-fstclassmod/*.lib
+/testsuite/tests/typing-fstclassmod/*.dll
+/testsuite/tests/typing-fstclassmod/*.cm[ioxat]
+/testsuite/tests/typing-fstclassmod/*.cmx[as]
+/testsuite/tests/typing-fstclassmod/*.cmti
+/testsuite/tests/typing-fstclassmod/*.annot
+/testsuite/tests/typing-fstclassmod/*.result
+/testsuite/tests/typing-fstclassmod/*.byte
+/testsuite/tests/typing-fstclassmod/*.native
+/testsuite/tests/typing-fstclassmod/program
+/testsuite/tests/typing-fstclassmod/*.exe
+/testsuite/tests/typing-fstclassmod/*.exe.manifest
+/testsuite/tests/typing-fstclassmod/.depend
+/testsuite/tests/typing-fstclassmod/.depend.nt
+/testsuite/tests/typing-fstclassmod/.DS_Store
+
+# /testsuite/tests/typing-gadts/
+/testsuite/tests/typing-gadts/*.o
+/testsuite/tests/typing-gadts/*.a
+/testsuite/tests/typing-gadts/*.so
+/testsuite/tests/typing-gadts/*.obj
+/testsuite/tests/typing-gadts/*.cm[ioxa]
+/testsuite/tests/typing-gadts/*.cmx[as]
+/testsuite/tests/typing-gadts/*.annot
+/testsuite/tests/typing-gadts/*.result
+/testsuite/tests/typing-gadts/*.byte
+/testsuite/tests/typing-gadts/*.native
+/testsuite/tests/typing-gadts/program
+/testsuite/tests/typing-gadts/.depend
+/testsuite/tests/typing-gadts/.depend.nt
+/testsuite/tests/typing-gadts/.DS_Store
+
+# /testsuite/tests/typing-implicit_unpack/
+/testsuite/tests/typing-implicit_unpack/*.o
+/testsuite/tests/typing-implicit_unpack/*.a
+/testsuite/tests/typing-implicit_unpack/*.so
+/testsuite/tests/typing-implicit_unpack/*.obj
+/testsuite/tests/typing-implicit_unpack/*.cm[ioxa]
+/testsuite/tests/typing-implicit_unpack/*.cmx[as]
+/testsuite/tests/typing-implicit_unpack/*.annot
+/testsuite/tests/typing-implicit_unpack/*.result
+/testsuite/tests/typing-implicit_unpack/*.byte
+/testsuite/tests/typing-implicit_unpack/*.native
+/testsuite/tests/typing-implicit_unpack/program
+/testsuite/tests/typing-implicit_unpack/.depend
+/testsuite/tests/typing-implicit_unpack/.depend.nt
+/testsuite/tests/typing-implicit_unpack/.DS_Store
+
+# /testsuite/tests/typing-labels/
+/testsuite/tests/typing-labels/*.o
+/testsuite/tests/typing-labels/*.a
+/testsuite/tests/typing-labels/*.so
+/testsuite/tests/typing-labels/*.obj
+/testsuite/tests/typing-labels/*.cm[ioxa]
+/testsuite/tests/typing-labels/*.cmx[as]
+/testsuite/tests/typing-labels/*.annot
+/testsuite/tests/typing-labels/*.result
+/testsuite/tests/typing-labels/*.byte
+/testsuite/tests/typing-labels/*.native
+/testsuite/tests/typing-labels/program
+/testsuite/tests/typing-labels/program.exe
+/testsuite/tests/typing-labels/.depend
+/testsuite/tests/typing-labels/.depend.nt
+/testsuite/tests/typing-labels/.DS_Store
+
+# /testsuite/tests/typing-misc/
+/testsuite/tests/typing-misc/*.o
+/testsuite/tests/typing-misc/*.a
+/testsuite/tests/typing-misc/*.so
+/testsuite/tests/typing-misc/*.obj
+/testsuite/tests/typing-misc/*.cm[ioxa]
+/testsuite/tests/typing-misc/*.cmx[as]
+/testsuite/tests/typing-misc/*.annot
+/testsuite/tests/typing-misc/*.result
+/testsuite/tests/typing-misc/*.byte
+/testsuite/tests/typing-misc/*.native
+/testsuite/tests/typing-misc/program
+/testsuite/tests/typing-misc/.depend
+/testsuite/tests/typing-misc/.depend.nt
+/testsuite/tests/typing-misc/.DS_Store
+
+# /testsuite/tests/typing-modules/
+/testsuite/tests/typing-modules/# svn propset -R svn:ignore -F .svnignore .
+/testsuite/tests/typing-modules/# find . -name .svnignore -print | while read f; do svn propset svn:ignore -F $f `dirname $f`; done
+/testsuite/tests/typing-modules/_log
+/testsuite/tests/typing-modules/*.so
+/testsuite/tests/typing-modules/*.a
+/testsuite/tests/typing-modules/*.result
+/testsuite/tests/typing-modules/*.byte
+/testsuite/tests/typing-modules/*.native
+/testsuite/tests/typing-modules/program
+
+# /testsuite/tests/typing-modules-bugs/
+/testsuite/tests/typing-modules-bugs/*.o
+/testsuite/tests/typing-modules-bugs/*.a
+/testsuite/tests/typing-modules-bugs/*.so
+/testsuite/tests/typing-modules-bugs/*.obj
+/testsuite/tests/typing-modules-bugs/*.cm[ioxa]
+/testsuite/tests/typing-modules-bugs/*.cmx[as]
+/testsuite/tests/typing-modules-bugs/*.annot
+/testsuite/tests/typing-modules-bugs/*.result
+/testsuite/tests/typing-modules-bugs/*.byte
+/testsuite/tests/typing-modules-bugs/*.native
+/testsuite/tests/typing-modules-bugs/program
+/testsuite/tests/typing-modules-bugs/program.exe
+/testsuite/tests/typing-modules-bugs/.depend
+/testsuite/tests/typing-modules-bugs/.depend.nt
+/testsuite/tests/typing-modules-bugs/.DS_Store
+
+# /testsuite/tests/typing-objects/
+/testsuite/tests/typing-objects/*.o
+/testsuite/tests/typing-objects/*.a
+/testsuite/tests/typing-objects/*.so
+/testsuite/tests/typing-objects/*.obj
+/testsuite/tests/typing-objects/*.cm[ioxa]
+/testsuite/tests/typing-objects/*.cmx[as]
+/testsuite/tests/typing-objects/*.annot
+/testsuite/tests/typing-objects/*.result
+/testsuite/tests/typing-objects/*.byte
+/testsuite/tests/typing-objects/*.native
+/testsuite/tests/typing-objects/program
+/testsuite/tests/typing-objects/.depend
+/testsuite/tests/typing-objects/.depend.nt
+/testsuite/tests/typing-objects/.DS_Store
+
+# /testsuite/tests/typing-objects-bugs/
+/testsuite/tests/typing-objects-bugs/# svn propset -R svn:ignore -F .svnignore .
+/testsuite/tests/typing-objects-bugs/# find . -name .svnignore -print | while read f; do svn propset svn:ignore -F $f `dirname $f`; done
+/testsuite/tests/typing-objects-bugs/_log
+/testsuite/tests/typing-objects-bugs/*.so
+/testsuite/tests/typing-objects-bugs/*.a
+/testsuite/tests/typing-objects-bugs/*.result
+/testsuite/tests/typing-objects-bugs/*.byte
+/testsuite/tests/typing-objects-bugs/*.native
+/testsuite/tests/typing-objects-bugs/program
+/testsuite/tests/typing-objects-bugs/*.cm*
+/testsuite/tests/typing-objects-bugs/*.o
+
+# /testsuite/tests/typing-poly/
+/testsuite/tests/typing-poly/*.o
+/testsuite/tests/typing-poly/*.a
+/testsuite/tests/typing-poly/*.so
+/testsuite/tests/typing-poly/*.obj
+/testsuite/tests/typing-poly/*.cm[ioxa]
+/testsuite/tests/typing-poly/*.cmx[as]
+/testsuite/tests/typing-poly/*.annot
+/testsuite/tests/typing-poly/*.result
+/testsuite/tests/typing-poly/*.byte
+/testsuite/tests/typing-poly/*.native
+/testsuite/tests/typing-poly/program
+/testsuite/tests/typing-poly/.depend
+/testsuite/tests/typing-poly/.depend.nt
+/testsuite/tests/typing-poly/.DS_Store
+
+# /testsuite/tests/typing-poly-bugs/
+/testsuite/tests/typing-poly-bugs/*.o
+/testsuite/tests/typing-poly-bugs/*.a
+/testsuite/tests/typing-poly-bugs/*.so
+/testsuite/tests/typing-poly-bugs/*.obj
+/testsuite/tests/typing-poly-bugs/*.cm[ioxa]
+/testsuite/tests/typing-poly-bugs/*.cmx[as]
+/testsuite/tests/typing-poly-bugs/*.annot
+/testsuite/tests/typing-poly-bugs/*.result
+/testsuite/tests/typing-poly-bugs/*.byte
+/testsuite/tests/typing-poly-bugs/*.native
+/testsuite/tests/typing-poly-bugs/program
+/testsuite/tests/typing-poly-bugs/program.exe
+/testsuite/tests/typing-poly-bugs/.depend
+/testsuite/tests/typing-poly-bugs/.depend.nt
+/testsuite/tests/typing-poly-bugs/.DS_Store
+
+# /testsuite/tests/typing-polyvariants-bugs/
+/testsuite/tests/typing-polyvariants-bugs/# svn propset -R svn:ignore -F .svnignore .
+/testsuite/tests/typing-polyvariants-bugs/# find . -name .svnignore -print | while read f; do svn propset svn:ignore -F $f `dirname $f`; done
+/testsuite/tests/typing-polyvariants-bugs/_log
+/testsuite/tests/typing-polyvariants-bugs/*.so
+/testsuite/tests/typing-polyvariants-bugs/*.a
+/testsuite/tests/typing-polyvariants-bugs/*.result
+/testsuite/tests/typing-polyvariants-bugs/*.byte
+/testsuite/tests/typing-polyvariants-bugs/*.native
+/testsuite/tests/typing-polyvariants-bugs/program
+/testsuite/tests/typing-polyvariants-bugs/*.cm*
+/testsuite/tests/typing-polyvariants-bugs/*.o
+
+# /testsuite/tests/typing-polyvariants-bugs-2/
+/testsuite/tests/typing-polyvariants-bugs-2/# svn propset -R svn:ignore -F .svnignore .
+/testsuite/tests/typing-polyvariants-bugs-2/# find . -name .svnignore -print | while read f; do svn propset svn:ignore -F $f `dirname $f`; done
+/testsuite/tests/typing-polyvariants-bugs-2/_log
+/testsuite/tests/typing-polyvariants-bugs-2/*.so
+/testsuite/tests/typing-polyvariants-bugs-2/*.a
+/testsuite/tests/typing-polyvariants-bugs-2/*.result
+/testsuite/tests/typing-polyvariants-bugs-2/*.byte
+/testsuite/tests/typing-polyvariants-bugs-2/*.native
+/testsuite/tests/typing-polyvariants-bugs-2/program
+/testsuite/tests/typing-polyvariants-bugs-2/*.cm*
+/testsuite/tests/typing-polyvariants-bugs-2/*.o
+
+# /testsuite/tests/typing-private/
+/testsuite/tests/typing-private/*.o
+/testsuite/tests/typing-private/*.a
+/testsuite/tests/typing-private/*.so
+/testsuite/tests/typing-private/*.obj
+/testsuite/tests/typing-private/*.cm[ioxa]
+/testsuite/tests/typing-private/*.cmx[as]
+/testsuite/tests/typing-private/*.annot
+/testsuite/tests/typing-private/*.result
+/testsuite/tests/typing-private/*.byte
+/testsuite/tests/typing-private/*.native
+/testsuite/tests/typing-private/program
+/testsuite/tests/typing-private/.depend
+/testsuite/tests/typing-private/.depend.nt
+/testsuite/tests/typing-private/.DS_Store
+
+# /testsuite/tests/typing-private-bugs/
+/testsuite/tests/typing-private-bugs/# svn propset -R svn:ignore -F .svnignore .
+/testsuite/tests/typing-private-bugs/# find . -name .svnignore -print | while read f; do svn propset svn:ignore -F $f `dirname $f`; done
+/testsuite/tests/typing-private-bugs/_log
+/testsuite/tests/typing-private-bugs/*.so
+/testsuite/tests/typing-private-bugs/*.a
+/testsuite/tests/typing-private-bugs/*.result
+/testsuite/tests/typing-private-bugs/*.byte
+/testsuite/tests/typing-private-bugs/*.native
+/testsuite/tests/typing-private-bugs/program
+/testsuite/tests/typing-private-bugs/*.cm*
+/testsuite/tests/typing-private-bugs/*.o
+
+# /testsuite/tests/typing-recmod/
+/testsuite/tests/typing-recmod/# svn propset -R svn:ignore -F .svnignore .
+/testsuite/tests/typing-recmod/# find . -name .svnignore -print | while read f; do svn propset svn:ignore -F $f `dirname $f`; done
+/testsuite/tests/typing-recmod/_log
+/testsuite/tests/typing-recmod/*.so
+/testsuite/tests/typing-recmod/*.a
+/testsuite/tests/typing-recmod/*.result
+/testsuite/tests/typing-recmod/*.byte
+/testsuite/tests/typing-recmod/*.native
+/testsuite/tests/typing-recmod/program
+/testsuite/tests/typing-recmod/*.cm*
+/testsuite/tests/typing-recmod/*.o
+
+# /testsuite/tests/typing-short-paths/
+/testsuite/tests/typing-short-paths/*.o
+/testsuite/tests/typing-short-paths/*.a
+/testsuite/tests/typing-short-paths/*.so
+/testsuite/tests/typing-short-paths/*.obj
+/testsuite/tests/typing-short-paths/*.cm[ioxat]
+/testsuite/tests/typing-short-paths/*.cmx[as]
+/testsuite/tests/typing-short-paths/*.cmti
+/testsuite/tests/typing-short-paths/*.annot
+/testsuite/tests/typing-short-paths/*.result
+/testsuite/tests/typing-short-paths/*.byte
+/testsuite/tests/typing-short-paths/*.native
+/testsuite/tests/typing-short-paths/program
+/testsuite/tests/typing-short-paths/program.exe
+/testsuite/tests/typing-short-paths/.depend
+/testsuite/tests/typing-short-paths/.depend.nt
+/testsuite/tests/typing-short-paths/.DS_Store
+
+# /testsuite/tests/typing-signatures/
+/testsuite/tests/typing-signatures/*.o
+/testsuite/tests/typing-signatures/*.a
+/testsuite/tests/typing-signatures/*.so
+/testsuite/tests/typing-signatures/*.obj
+/testsuite/tests/typing-signatures/*.cm[ioxa]
+/testsuite/tests/typing-signatures/*.cmx[as]
+/testsuite/tests/typing-signatures/*.annot
+/testsuite/tests/typing-signatures/*.result
+/testsuite/tests/typing-signatures/*.byte
+/testsuite/tests/typing-signatures/*.native
+/testsuite/tests/typing-signatures/program
+/testsuite/tests/typing-signatures/.depend
+/testsuite/tests/typing-signatures/.depend.nt
+/testsuite/tests/typing-signatures/.DS_Store
+
+# /testsuite/tests/typing-sigsubst/
+/testsuite/tests/typing-sigsubst/*.o
+/testsuite/tests/typing-sigsubst/*.a
+/testsuite/tests/typing-sigsubst/*.so
+/testsuite/tests/typing-sigsubst/*.obj
+/testsuite/tests/typing-sigsubst/*.cm[ioxa]
+/testsuite/tests/typing-sigsubst/*.cmx[as]
+/testsuite/tests/typing-sigsubst/*.annot
+/testsuite/tests/typing-sigsubst/*.result
+/testsuite/tests/typing-sigsubst/*.byte
+/testsuite/tests/typing-sigsubst/*.native
+/testsuite/tests/typing-sigsubst/program
+/testsuite/tests/typing-sigsubst/.depend
+/testsuite/tests/typing-sigsubst/.depend.nt
+/testsuite/tests/typing-sigsubst/.DS_Store
+
+# /testsuite/tests/typing-typeparam/
+/testsuite/tests/typing-typeparam/*.o
+/testsuite/tests/typing-typeparam/*.a
+/testsuite/tests/typing-typeparam/*.so
+/testsuite/tests/typing-typeparam/*.obj
+/testsuite/tests/typing-typeparam/*.cm[ioxa]
+/testsuite/tests/typing-typeparam/*.cmx[as]
+/testsuite/tests/typing-typeparam/*.annot
+/testsuite/tests/typing-typeparam/*.result
+/testsuite/tests/typing-typeparam/*.byte
+/testsuite/tests/typing-typeparam/*.native
+/testsuite/tests/typing-typeparam/program
+/testsuite/tests/typing-typeparam/.depend
+/testsuite/tests/typing-typeparam/.depend.nt
+/testsuite/tests/typing-typeparam/.DS_Store
+
+# /testsuite/tests/typing-warnings/
+/testsuite/tests/typing-warnings/*.o
+/testsuite/tests/typing-warnings/*.a
+/testsuite/tests/typing-warnings/*.so
+/testsuite/tests/typing-warnings/*.obj
+/testsuite/tests/typing-warnings/*.cm[ioxat]
+/testsuite/tests/typing-warnings/*.cmx[as]
+/testsuite/tests/typing-warnings/*.cmti
+/testsuite/tests/typing-warnings/*.annot
+/testsuite/tests/typing-warnings/*.result
+/testsuite/tests/typing-warnings/*.byte
+/testsuite/tests/typing-warnings/*.native
+/testsuite/tests/typing-warnings/program
+/testsuite/tests/typing-warnings/program.exe
+/testsuite/tests/typing-warnings/.depend
+/testsuite/tests/typing-warnings/.depend.nt
+/testsuite/tests/typing-warnings/.DS_Store
+
+# /testsuite/tests/utils/
+/testsuite/tests/utils/*.o
+/testsuite/tests/utils/*.a
+/testsuite/tests/utils/*.so
+/testsuite/tests/utils/*.obj
+/testsuite/tests/utils/*.cm[ioxat]
+/testsuite/tests/utils/*.cmx[as]
+/testsuite/tests/utils/*.cmti
+/testsuite/tests/utils/*.annot
+/testsuite/tests/utils/*.result
+/testsuite/tests/utils/*.byte
+/testsuite/tests/utils/*.native
+/testsuite/tests/utils/program
+/testsuite/tests/utils/program.exe
+/testsuite/tests/utils/.depend
+/testsuite/tests/utils/.depend.nt
+/testsuite/tests/utils/.DS_Store
+
+# /testsuite/tests/warnings/
+/testsuite/tests/warnings/*.o
+/testsuite/tests/warnings/*.a
+/testsuite/tests/warnings/*.so
+/testsuite/tests/warnings/*.obj
+/testsuite/tests/warnings/*.lib
+/testsuite/tests/warnings/*.dll
+/testsuite/tests/warnings/*.cm[ioxat]
+/testsuite/tests/warnings/*.cmx[as]
+/testsuite/tests/warnings/*.cmti
+/testsuite/tests/warnings/*.annot
+/testsuite/tests/warnings/*.result
+/testsuite/tests/warnings/*.byte
+/testsuite/tests/warnings/*.native
+/testsuite/tests/warnings/program
+/testsuite/tests/warnings/*.exe
+/testsuite/tests/warnings/*.exe.manifest
+/testsuite/tests/warnings/.depend
+/testsuite/tests/warnings/.depend.nt
+/testsuite/tests/warnings/.DS_Store
+
+# /tools/
+/tools/*.o
+/tools/*.a
+/tools/*.so
+/tools/*.obj
+/tools/*.lib
+/tools/*.dll
+/tools/*.cm[ioxat]
+/tools/*.cmx[as]
+/tools/*.cmti
+/tools/*.annot
+/tools/*.result
+/tools/*.byte
+/tools/*.native
+/tools/program
+/tools/*.exe
+/tools/*.exe.manifest
+/tools/.depend
+/tools/.depend.nt
+/tools/.DS_Store
+/tools/ocamldep
+/tools/ocamldep.opt
+/tools/ocamldep.bak
+/tools/ocamlprof
+/tools/opnames.ml
+/tools/dumpobj
+/tools/dumpapprox
+/tools/objinfo
+/tools/cvt_emit
+/tools/cvt_emit.bak
+/tools/cvt_emit.ml
+/tools/ocamlcp
+/tools/ocamloptp
+/tools/ocamlmktop
+/tools/primreq
+/tools/ocamldumpobj
+/tools/keywords
+/tools/lexer299.ml
+/tools/ocaml299to3
+/tools/ocamlmklib
+/tools/ocamlmklibconfig.ml
+/tools/lexer301.ml
+/tools/scrapelabels
+/tools/addlabels
+/tools/objinfo_helper
+/tools/read_cmt
+/tools/read_cmt.opt
+
+# /toplevel/
+/toplevel/.depend
+/toplevel/configure
+/toplevel/ocamlc
+/toplevel/ocamlc.opt
+/toplevel/expunge
+/toplevel/ocaml
+/toplevel/ocamlopt
+/toplevel/ocamlopt.opt
+/toplevel/ocamlcomp.sh
+/toplevel/ocamlcompopt.sh
+/toplevel/package-macosx
+/toplevel/.DS_Store
+/toplevel/*.annot
+/toplevel/_boot_log1
+/toplevel/_boot_log2
+/toplevel/_build
+/toplevel/_log
+/toplevel/myocamlbuild_config.ml
+/toplevel/ocamlnat
+/toplevel/*.cm*
+/toplevel/*.o
+
+# /typing/
+/typing/*.o
+/typing/*.a
+/typing/*.so
+/typing/*.obj
+/typing/*.dll
+/typing/*.cm[ioxat]
+/typing/*.cmx[as]
+/typing/*.cmti
+/typing/*.annot
+/typing/*.result
+/typing/*.byte
+/typing/*.native
+/typing/program
+/typing/*.exe
+/typing/.depend
+/typing/.depend.nt
+/typing/.DS_Store
+
+# /utils/
+/utils/*.o
+/utils/*.a
+/utils/*.so
+/utils/*.obj
+/utils/*.dll
+/utils/*.cm[ioxat]
+/utils/*.cmx[as]
+/utils/*.cmti
+/utils/*.annot
+/utils/*.result
+/utils/*.byte
+/utils/*.native
+/utils/program
+/utils/*.exe
+/utils/.depend
+/utils/.depend.nt
+/utils/.DS_Store
+/utils/config.ml
+
+# /yacc/
+/yacc/*.o
+/yacc/*.a
+/yacc/*.so
+/yacc/*.obj
+/yacc/*.cm[ioxa]
+/yacc/*.cmx[as]
+/yacc/*.annot
+/yacc/*.result
+/yacc/*.byte
+/yacc/*.native
+/yacc/program
+/yacc/program.exe
+/yacc/.depend
+/yacc/.depend.nt
+/yacc/.DS_Store
+/yacc/ocamlyacc
+/yacc/ocamlyacc.exe
+/yacc/version.h
+/yacc/.gdb_history
diff --git a/.travis-ci.sh b/.travis-ci.sh
new file mode 100644
index 0000000000..bee3ad19bb
--- /dev/null
+++ b/.travis-ci.sh
@@ -0,0 +1,19 @@
+case $XARCH in
+i386)
+  ./configure
+  make world.opt
+  sudo make install
+  cd testsuite && make all
+  git clone git://github.com/ocaml/camlp4
+  cd camlp4 && ./configure && make && sudo make install
+  git clone git://github.com/ocaml/opam
+  cd opam && ./configure && make lib-ext && make && sudo make install
+  opam init -y -a git://github.com/ocaml/opam-repository
+  opam install -y oasis
+  opam pin add -y utop https://github.com/diml/utop
+  ;;
+*)
+  echo unknown arch
+  exit 1
+  ;;
+esac
diff --git a/.travis.yml b/.travis.yml
new file mode 100644
index 0000000000..3015c16d3b
--- /dev/null
+++ b/.travis.yml
@@ -0,0 +1,4 @@
+language: c
+script: bash -ex .travis-ci.sh
+env:
+   - XARCH=i386
diff --git a/Changes b/Changes
index 3a9bc539b6..7c1994c3f8 100644
--- a/Changes
+++ b/Changes
@@ -1,149 +1,299 @@
 Next version:
 -------------
 
+Ocaml 4.02.0:
+-------------
+
 (Changes that can break existing programs are marked with a "*")
 
 Language features:
 - Attributes and extension nodes
-- Generative functors
+  (Alain Frisch)
+- PR#5095: Generative functors
+  (Jacques Garrigue)
 - Module aliases
+  (Jacques Garrigue)
+* Alternative syntax for string literals {id|...|id} (can break comments)
+  (Alain Frisch)
+- Separation between read-only strings (type string) and read-write byte
+  sequences (type bytes). Activated by command-line option -safe-string.
+  (Damien Doligez)
+- PR#6318: Exception cases in pattern matching
+  (Jeremy Yallop, backend by Alain Frisch)
+- PR#5584: Extensible open datatypes
+  (Leo White)
 
 Build system for the OCaml distribution:
 - Use -bin-annot when building.
+- Use GNU make instead of portable makefiles.
 
-Camlp4:
-- Removed from the official distribution
-
-Other libraries:
-* Labltk: removed from the distribution, now available as a third-party library
+Shedding weight:
+* Removed Camlp4 from the distribution, now available as third-party software.
+* Removed Labltk from the distribution, now available as a third-party library.
 
 Type system:
-* Keep typing of pattern cases independent in principal mode
+* PR#6235: Keep typing of pattern cases independent in principal mode
   (i.e. information from previous cases is no longer used when typing
   patterns; cf. 'PR#6235' in testsuite/test/typing-warnings/records.ml)
+  (Jacques Garrigue)
 - Allow opening a first-class module or applying a generative functor
   in the body of a generative functor. Allow it also in the body of
   an applicative functor if no types are created
+  (Jacques Garrigue, suggestion by Leo White)
 * Module aliases are now typed in a specific way, which remembers their
   identity. In particular this changes the signature inferred by
   "module type of"
+  (Jacques Garrigue)
 - PR#6331: Slight change in the criterion to distinguish private
   abbreviations and private row types: create a private abbreviation for
   closed objects and fixed polymorphic variants.
-- PR#6333: Compare first class module types structurally rather than
+  (Jacques Garrigue)
+* PR#6333: Compare first class module types structurally rather than
   nominally. Value subtyping allows module subtyping as long as the internal
   representation is unchanged.
+  (Jacques Garrigue)
 
 Compilers:
-- PR#6269 Optimization of string matching (patch by Benoit Vaugon
-  and Luc Maranget)
+- More aggressive constant propagation, including float and
+  int32/int64/nativeint arithmetic.  Constant propagation for floats
+  can be turned off with option -no-float-const-prop, for codes that
+  change FP rounding modes at run-time.
+  (Xavier Leroy)
+- New back-end optimization pass: common subexpression elimination (CSE).
+  (Reuses results of previous computations instead of recomputing them.)
+  (Xavier Leroy)
+- New back-end optimization pass: dead code elimination.
+  (Removes arithmetic and load instructions whose results are unused.)
+  (Xavier Leroy)
+- PR#6269: Optimization of sequences of string patterns
+  (Benoît Vaugon and Luc Maranget)
 - Experimental native code generator for AArch64 (ARM 64 bits)
-- Optimization of integer division and modulus by constant divisors
-  (feature wish PR#6042)
+  (Xavier Leroy)
+- PR#6042: Optimization of integer division and modulus by constant divisors
+  (Xavier Leroy and Phil Denys)
+- Add "-open" command line flag for opening a single module before typing
+* "-o" now sets module name to the output file name up to the first "."
+  (it also applies when "-o" is not given, i.e. the module name is then
+   the input file name up to the first ".")
+  (Leo White and Mark Shinwell)
+* PR#5779: better sharing of structured constants
+  (Alain Frisch)
 - PR#6182: better message for virtual objects and class types
   (Leo P. White, Stephen Dolan)
 - PR#5817: new flag to keep locations in cmi files
+  (Alain Frisch)
 - PR#5854: issue warning 3 when referring to a value marked with
-  the [@@deprecated] attribute
-- PR#6203: Constant exception constructor no longer allocate
+  the [@@ocaml.deprecated] attribute
+  (Alain Frisch, suggestion by Pierre-Marie Pédrot)
+* PR#6203: Constant exception constructors no longer allocate
+  (Alain Frisch)
 - PR#6311: Improve signature mismatch error messages
+  (Alain Frisch, suggestion by Daniel Bünzli)
 - PR#6345: Better compilation of optional arguments with default values
-- PR#6260: Unnecessary boxing in let (patch by vbrankov)
+  (Alain Frisch, review by Jacques Garrigue)
+- PR#6260: Unnecessary boxing in let
+  (Vladimir Brankov)
+- PR#6017: a new format implementation based on GADTs
+  (Benoît Vaugon and Gabriel Scherer)
 
 Toplevel interactive system:
-- Support for directive with multiple arguments
-- PR#5377: New "#show" directive
+- PR#5377: New "#show_*" directives
+  (ygrek, Jacques Garrigue and Alain Frisch)
 
 Runtime system:
+- New configure option "-no-naked-pointers" to improve performance by
+  avoiding page table tests during block darkening and the marking phase
+  of the major GC.  In this mode, all out-of-heap pointers must point at
+  things that look like OCaml values: in particular they must have a valid
+  header.  The colour of said headers should be black.
+  (Mark Shinwell, reviews by Damien Doligez and Xavier Leroy)
+- Fixed bug in native code version of [caml_raise_with_string] that could
+  potentially lead to heap corruption.
+  (Mark Shinwell)
+- Blocks initialized by [CAMLlocal*] and [caml_alloc] are now filled with
+  [Val_unit] rather than zero.
+  (Mark Shinwell)
 - Fixed a major performance problem on large heaps (~1GB) by making heap
-  increments proportional to heap size
+  increments proportional to heap size by default
+  (Damien Doligez)
 - PR#4765: Structural equality should treat exception specifically
-- PR#5009: Extending exception tag blocks
+  (Alain Frisch)
+- PR#5009: efficient comparison/indexing of exceptions
+  (Alain Frisch, request by Markus Mottl)
 - PR#6075: avoid using unsafe C library functions (strcpy, strcat, sprintf)
+  (Xavier Leroy, reports from user 'jfc' and Anil Madhavapeddy)
 - An ISO C99-compliant C compiler and standard library is now assumed.
   (Plus special exceptions for MSVC.)  In particular, emulation code for
   64-bit integer arithmetic was removed, the C compiler must support a
   64-bit integer type.
+  (Xavier Leroy)
 
 Standard library:
+* Add new modules: Bytes and BytesLabels.
+  (Damien Doligez)
 - PR#4986: add List.sort_uniq and Set.of_list
+  (Alain Frisch)
 - PR#5935: a faster version of "raise" which does not maintain the backtrace
+  (Alain Frisch)
 - PR#6146: support "Unix.kill pid Sys.sigkill" under Windows
-- PR#6148: speed improvement for Buffer (patch by John Whitington)
+  (Romain Bardou and Alain Frisch)
+- PR#6148: speed improvement for Buffer
+  (John Whitington)
 - PR#6180: efficient creation of uninitialized float arrays
+  (Alain Frisch, request by Markus Mottl)
 
 OCamldoc:
 - PR#6257: handle full doc comments for variant constructors and
-           record fields
+  record fields
+  (Maxence Guesdon, request by ygrek)
 - PR#6310: fix ocamldoc's subscript/superscript CSS font size
-           (patch by Anil Madhavapeddy)
-- PR#6273: fix Sys.file_exists on large files (Win32)
-           (patch by Christoph Bauer)
+  (Anil Madhavapeddy)
+- PR#6425: fix generation of man pages
+  (Maxence Guesdon, report by Anil Madhavapeddy)
 
 Bug fixes:
+- PR#2719: wrong scheduling of bound checks within a
+  try...with Invalid_argument -> _ ...  (Xavier Leroy)
 - PR#4719: Sys.executable_name wrong if executable name contains dots (Windows)
+  (Alain Frisch, report by Bart Jacobs)
 - PR#4855: 'camlp4 -I +dir' accepted, dir is relative to 'camlp4 -where'
+  (Jun Furuse and Hongbo Zhang, report by Dmitry Grebeniuk)
 - PR#5201: ocamlbuild: add --norc to the bash invocation to help performances
+  (user 'daweil')
 - PR#5598: follow-up fix related to PR#6165
+  (Damien Doligez)
 - PR#5820: Fix camlp4 lexer roll back problem
+  (Hongbo Zhang)
+- PR#6038: on x86-32, enforce 16-byte stack alignment for compatibility
+  with recent GCC and Clang.  Win32/MSVC keeps 4-byte stack alignment.
+  (Xavier Leroy)
 - PR#6062: Fix a regression bug caused by commit 13047
+  (Hongbo Zhang, report by Christophe Troestler)
 - PR#6109: Typos in ocamlbuild error messages
-- PR#6116: more efficient implementation of Digest.to_hex (patch by ygrek)
+  (Gabriel Kerneis)
+- PR#6116: more efficient implementation of Digest.to_hex
+  (ygrek)
+- PR#6142: add cmt file support to ocamlobjinfo
+  (Anil Madhavapeddy)
 - PR#6165: Alterations to handling of \013 in source files breaking other tools
-- PR#6173: Typing error message is worse that before
+  (David Allsopp)
+- PR#6173: Typing error message is worse than before
+  (Jacques Garrigue and John Whitington)
 - PR#6174: OCaml compiler loops on an example using GADTs (-rectypes case)
-- PR#6175: Fix open!
+  (Jacques Garrigue and Grégoire Henry, report by Chantal Keller)
+- PR#6175: add open! support to camlp4
+  (Hongbo Zhang)
 - PR#6183: enhanced documentation for 'Unix.shutdown_connection'
+  (Anil Madhavapeddy, report by Jun Furuse)
 - PR#6184: ocamlbuild: `ocamlfind ocamldep` does not support -predicate
-           (report and patch by Jacques-Pascal Deplaix)
+  (Jacques-Pascal Deplaix)
 - PR#6194: Incorrect unused warning with first-class modules in patterns
+  (Jacques Garrigue, report by Markus Mottl and Leo White)
+- PR#6211: in toplevel interactive use, bad interaction between uncaught
+  exceptions and multiple bindings of the form "let x = a let y = b;;".
+  (Xavier Leroy)
 - PR#6216: inlining of GADT matches generates invalid assembly
+  (Xavier Leroy and Alain Frisch, report by Mark Shinwell)
 - PR#6233: out-of-bounds exceptions lose their locations on ARM, PowerPC
+  (Jacques-Henri Jourdan and Xavier Leroy,
+   report and testing by Stéphane Glondu)
 - PR#6235: Issue with type information flowing through a variant pattern
+  (Jacques Garrigue, report by Hongbo Zhang)
 - PR#6239: sometimes wrong stack alignment when raising exceptions
            in -g mode with backtraces active
+  (Xavier Leroy, report by Yaron Minsky)
 - PR#6240: Fail to expand module type abbreviation during substyping
+  (Jacques Garrigue, report by Leo White)
 - PR#6241: Assumed inequality between paths involving functor arguments
+  (Jacques Garrigue, report by Jeremy Yallop)
 - PR#6243: Make "ocamlopt -g" more resistant to ill-formed locations
+  (Xavier Leroy, report by Pierre-Marie Pédrot)
 - PR#6262: equality of first-class modules take module aliases into account
+  (Alain Frisch and Leo White)
 - PR#6267: more information printed by "bt" command of ocamldebug
+  (Josh Watzman)
+- PR#6268: -DMODEL_$(MODEL) not passed when building asmrun/arm.p.o
+  (Peter Michael Green)
+- PR#6273: fix Sys.file_exists on large files (Win32)
+  (Christoph Bauer)
 - PR#6275: Soundness bug related to type constraints
+  (Jacques Garrigue, report by Leo White)
 - PR#6293: Assert_failure with invalid package type
+  (Jacques Garrigue, report by Elnatan Reisner)
+- PR#6302: bytecode debug information re-read from filesystem every time
+  (Jacques-Henri Jourdan)
 - PR#6307: Behavior of 'module type of' w.r.t. module aliases
+  (Jacques Garrigue, report by Alain Frisch)
 - PR#6346: Build failure with latest version of xcode on OSX
+  (Jérémie Dimino)
 - PR#6348: Unification failure for GADT when original definition is hidden
+  (Leo White and Jacques Garrigue, report by Jeremy Yallop)
 - PR#6352: Automatic removal of optional arguments and sequencing
+  (Jacques Garrigue and Alain Frisch)
+- PR#6361: Hashtbl.hash not terminating on some lazy values w/ recursive types
+  (Xavier Leroy, report by Leo White)
+- PR#6383: Exception Not_found when using object type in absent module
+  (Jacques Garrigue, report by Sébastien Briais)
+- PR#6384: Uncaught Not_found exception with a hidden .cmi file
+  (Leo White)
+- PR#6385: wrong allocation of large closures by the bytecode interpreter
+  (Xavier Leroy, report by Stephen Dolan)
+- PR#6394: Assertion failed in Typecore.expand_path
+  (Alain Frisch and Jacques Garrigue)
+- PR#6405: unsound interaction of -rectypes and GADTs
+  (Jacques Garrigue, report by Gabriel Scherer and Benoît Vaugon)
+- PR#6418: reimplement parametrized Format tags/indentation with GADTs
+  (Benoît Vaugon)
+- PR#6460: runtime assertion failure with large [| e1;...eN |]
+  float array expressions
+  (Leo White)
+- PR#6482: ocamlbuild fails when _tags file in unhygienic directory
+  (Gabriel Scherer)
+- PR#6509: add -linkall flag to ocamlcommon.cma
+  (Frédéric Bour)
 - fix -dsource printing of "external _pipe = ..."
   (Gabriel Scherer)
 - bound-checking bug in caml_string_{get,set}{16,32,64}
   (Pierre Chambart and Gabriel Scherer, report by Nicolas Trangez)
 - sometimes wrong stack alignment at out-of-bounds array access
-  (Gabriel Scherer, review by Xavier Leroy, report by Pierre Chambart)
+  (Gabriel Scherer and Xavier Leroy, report by Pierre Chambart)
 
 Features wishes:
 - PR#4243: make the Makefiles parallelizable
+  (Grégoire Henry and Damien Doligez)
 - PR#4323: have "of_string" in Num and Big_int work with binary and
-  hexa representations (patch by Zoe Paraskevopoulou)
-- PR#5547: Enable the "-use-ocamlfind" option by default
+           hex representations
+  (Zoe Paraskevopoulou, review by Gabriel Scherer)
 - PR#5650: Camlp4FoldGenerator doesn't handle well "abstract" types
-- PR#5808: allow simple patterns, not only identifiers, in "let p : t = ..."
-- PR#6000: add a warning for non-principal coercions to format
+  (Hongbo Zhang)
+- PR#5808: allow simple patterns, not just identifiers, in "let p : t = ..."
+  (Alain Frisch)
+- PR#5899: a programmer-friendly access to backtrace information
+  (Jacques-Henri Jourdan and Gabriel Scherer)
+- PR#6000 comment 9644: add a warning for non-principal coercions to format
+  (Jacques Garrigue, report by Damien Doligez)
 - PR#6054: add support for M.[ foo ], M.[| foo |] etc.
-           (patch by Kaustuv Chaudhuri)
+  (Kaustuv Chaudhuri)
 - PR#6064: GADT representation for Bigarray.kind + CAML_BA_CHAR runtime kind
-- PR#6071: Add a -noinit option to the toplevel (patch by David Sheets)
+  (Jeremy Yallop, review by Gabriel Scherer)
+- PR#6071: Add a -noinit option to the toplevel
+  (David Sheets)
 - PR#6166: document -ocamldoc option of ocamlbuild
+  (Xavier Clerc)
 - PR#6187: ocamlbuild: warn when using -plugin-tag(s) without myocamlbuild.ml
-  (patch by Jacques-Pascal Deplaix)
+  (Jacques-Pascal Deplaix)
 - PR#6246: allow wilcard _ as for-loop index
+  (Alain Frisch, request by ygrek)
 - PR#6270: remove need for -I directives to ocamldebug in common case
-  (patch by Josh Watzman, review by Xavier Clerc and Alain Frisch)
+  (Josh Watzman, review by Xavier Clerc and Alain Frisch)
 - PR#6358: obey DESTDIR in install targets
-  (Gabriel Scherer)
+  (Gabriel Scherer, request by François Berenger)
+- PR#6406: Expose OCaml version in C headers
+  (Peter Zotov and Romain Calascibetta)
 - ocamllex: user-definable refill action
-  (patch by Frédéric Bour, review by Gabriel Scherer and Luc Maranget)
+  (Frédéric Bour, review by Gabriel Scherer and Luc Maranget)
 - shorten syntax for functor signatures: "functor (M1:S1) (M2:S2) .. -> .."
-  (patches by Thomas Gazagnaire and Jeremy Yallop, review by Gabriel Scherer)
+  (Thomas Gazagnaire and Jeremy Yallop, review by Gabriel Scherer)
 
 
 OCaml 4.01.0:
@@ -301,7 +451,7 @@ Bug fixes:
   (Alain Frisch)
 - PR#5552: unrecognized gcc option -no-cpp-precomp
   (Damien Doligez, report by Markus Mottl)
-- PR#5580: missed opportunities for constant propagation
+* PR#5580: missed opportunities for constant propagation
   (Xavier Leroy and John Carr)
 - PR#5611: avoid clashes betwen .cmo files and output files during linking
   (Wojciech Meyer)
@@ -498,8 +648,6 @@ Bug fixes:
   (Jacques Garrigue, report by Elnatan Reisner)
 - PR#6058: 'ocamlbuild -use-ocamlfind -tag thread -package threads t.cma' fails
   (Gabriel Scherer, report by Hezekiah M. Carty)
-- PR#6060: ocamlbuild rules for -principal, -strict-sequence and -short-paths
-  (Anil Madhavapeddy)
 - PR#6069: ocamldoc: lexing: empty token
   (Maxence Guesdon, Grégoire Henry, report by ygrek)
 - PR#6072: configure does not handle FreeBSD current (i.e. 10) correctly
@@ -565,6 +713,12 @@ Feature wishes:
   (Anil Madhavapeddy, review by Benedikt Meurer)
 - PR#6059: add -output-obj rules for ocamlbuild
   (Anil Madhavapeddy)
+- PR#6060: ocamlbuild tags 'principal', 'strict_sequence' and 'short_paths'
+  (Anil Madhavapeddy)
+- PR#6495: ocamlbuild tags 'safe_string', 'unsafe_string'
+  (Anil Madhavapeddy)
+- ocamlbuild tag 'no_alias_deps'
+  (Daniel Bünzli)
 
 Tools:
 - OCamlbuild now features a bin_annot tag to generate .cmt files.
diff --git a/INSTALL b/INSTALL
index c703d2ef78..63ae5c67bf 100644
--- a/INSTALL
+++ b/INSTALL
@@ -153,8 +153,9 @@ Examples:
   to build a 64-bit version of OCaml:
     ./configure -cc "gcc -m64"
 
-  On a MacOSX 10.6/Intel Core 2, to build a 32-bit version of OCaml:
-    ./configure -cc "gcc -m32" -as "as -arch i386" -aspp "gcc -m32 -c"
+  On Intel Mac OS X, to build a 32-bit version of OCaml:
+    ./configure -host "i386-apple-darwin13.2.0" -cc "gcc -arch i386 -m32" \
+      -as "as -arch i386" -aspp "gcc -arch i386 -m32 -c"
 
   For Sun Solaris with the "acc" compiler:
     ./configure -cc "acc -fast" -libs "-lucb"
diff --git a/Makefile b/Makefile
index ccddd149aa..733ed99d47 100644
--- a/Makefile
+++ b/Makefile
@@ -17,7 +17,8 @@ include stdlib/StdlibModules
 
 CAMLC=boot/ocamlrun boot/ocamlc -nostdlib -I boot
 CAMLOPT=boot/ocamlrun ./ocamlopt -nostdlib -I stdlib -I otherlibs/dynlink
-COMPFLAGS=-strict-sequence -w +33..39+48 -warn-error A -bin-annot $(INCLUDES)
+COMPFLAGS=-strict-sequence -w +33..39+48 -warn-error A -bin-annot \
+          -safe-string $(INCLUDES)
 LINKFLAGS=
 
 CAMLYACC=boot/ocamlyacc
@@ -84,10 +85,13 @@ ASMCOMP=asmcomp/arch.cmo asmcomp/debuginfo.cmo \
   asmcomp/clambda.cmo asmcomp/printclambda.cmo asmcomp/compilenv.cmo \
   asmcomp/closure.cmo asmcomp/strmatch.cmo asmcomp/cmmgen.cmo \
   asmcomp/printmach.cmo asmcomp/selectgen.cmo asmcomp/selection.cmo \
-  asmcomp/comballoc.cmo asmcomp/liveness.cmo \
+  asmcomp/comballoc.cmo \
+  asmcomp/CSEgen.cmo asmcomp/CSE.cmo \
+  asmcomp/liveness.cmo \
   asmcomp/spill.cmo asmcomp/split.cmo \
   asmcomp/interf.cmo asmcomp/coloring.cmo \
   asmcomp/reloadgen.cmo asmcomp/reload.cmo \
+  asmcomp/deadcode.cmo \
   asmcomp/printlinear.cmo asmcomp/linearize.cmo \
   asmcomp/schedgen.cmo asmcomp/scheduling.cmo \
   asmcomp/emitaux.cmo asmcomp/emit.cmo asmcomp/asmgen.cmo \
@@ -121,11 +125,7 @@ defaultentry:
 # Recompile the system using the bootstrap compiler
 all:
 	$(MAKE) runtime
-	$(MAKE) ocamlc
-	$(MAKE) ocamllex
-	$(MAKE) ocamlyacc
-	$(MAKE) ocamltools
-	$(MAKE) library
+	$(MAKE) coreall
 	$(MAKE) ocaml
 	$(MAKE) otherlibraries $(OCAMLBUILDBYTE) $(WITH_DEBUGGER) \
 	  $(WITH_OCAMLDOC)
@@ -145,11 +145,10 @@ world.opt:
 #
 # make coreboot     [old system -- you were in a stable state]
 # <change the source>
-# make core         [cross-compiler]
-# make partialclean [if you get "inconsistent assumptions"]
+# make clean runtime coreall
 # <debug your changes>
-# make core         [cross-compiler]
-# make coreboot     [new system -- now you are in a stable state]
+# make clean runtime coreall
+# make coreboot [new system -- now in a stable state]
 
 # Core bootstrapping cycle
 coreboot:
@@ -198,8 +197,7 @@ coldstart:
 # Build the core system: the minimum needed to make depend and bootstrap
 core:
 	$(MAKE) coldstart
-	$(MAKE) ocamlc
-	$(MAKE) ocamllex ocamlyacc ocamltools library
+	$(MAKE) coreall
 
 # Recompile the core system using the bootstrap compiler
 coreall:
@@ -374,7 +372,7 @@ clean:: partialclean
 # Shared parts of the system
 
 compilerlibs/ocamlcommon.cma: $(COMMON)
-	$(CAMLC) -a -o $@ $(COMMON)
+	$(CAMLC) -a -linkall -o $@ $(COMMON)
 partialclean::
 	rm -f compilerlibs/ocamlcommon.cma
 
@@ -464,7 +462,6 @@ utils/config.ml: utils/config.mlp config/Makefile
 	    -e 's|%%HOST%%|$(HOST)|' \
 	    -e 's|%%TARGET%%|$(TARGET)|' \
 	    utils/config.mlp > utils/config.ml
-	@chmod -w utils/config.ml
 
 partialclean::
 	rm -f utils/config.ml
@@ -494,7 +491,7 @@ beforedepend:: parsing/lexer.ml
 # Shared parts of the system compiled with the native-code compiler
 
 compilerlibs/ocamlcommon.cmxa: $(COMMON:.cmo=.cmx)
-	$(CAMLOPT) -a -o $@ $(COMMON:.cmo=.cmx)
+	$(CAMLOPT) -a -linkall -o $@ $(COMMON:.cmo=.cmx)
 partialclean::
 	rm -f compilerlibs/ocamlcommon.cmxa compilerlibs/ocamlcommon.a
 
@@ -588,6 +585,14 @@ partialclean::
 
 beforedepend:: asmcomp/selection.ml
 
+asmcomp/CSE.ml: asmcomp/$(ARCH)/CSE.ml
+	ln -s $(ARCH)/CSE.ml asmcomp/CSE.ml
+
+partialclean::
+	rm -f asmcomp/CSE.ml
+
+beforedepend:: asmcomp/CSE.ml
+
 asmcomp/reload.ml: asmcomp/$(ARCH)/reload.ml
 	ln -s $(ARCH)/reload.ml asmcomp/reload.ml
 
@@ -839,7 +844,7 @@ distclean:
 	rm -f boot/ocamlrun boot/ocamlrun.exe boot/camlheader boot/ocamlyacc \
 	      boot/*.cm* boot/libcamlrun.a
 	rm -f config/Makefile config/m.h config/s.h
-	rm -f tools/*.bak tools/ocamlmklibconfig.ml
+	rm -f tools/*.bak
 	rm -f ocaml ocamlc
 	rm -f testsuite/_log
 
diff --git a/Makefile.nt b/Makefile.nt
index cfeaac4b52..648c918df1 100644
--- a/Makefile.nt
+++ b/Makefile.nt
@@ -81,10 +81,13 @@ ASMCOMP=asmcomp/arch.cmo asmcomp/debuginfo.cmo \
   asmcomp/clambda.cmo asmcomp/printclambda.cmo asmcomp/compilenv.cmo \
   asmcomp/closure.cmo asmcomp/strmatch.cmo asmcomp/cmmgen.cmo \
   asmcomp/printmach.cmo asmcomp/selectgen.cmo asmcomp/selection.cmo \
-  asmcomp/comballoc.cmo asmcomp/liveness.cmo \
+  asmcomp/comballoc.cmo \
+  asmcomp/CSEgen.cmo asmcomp/CSE.cmo \
+  asmcomp/liveness.cmo \
   asmcomp/spill.cmo asmcomp/split.cmo \
   asmcomp/interf.cmo asmcomp/coloring.cmo \
   asmcomp/reloadgen.cmo asmcomp/reload.cmo \
+  asmcomp/deadcode.cmo \
   asmcomp/printlinear.cmo asmcomp/linearize.cmo \
   asmcomp/schedgen.cmo asmcomp/scheduling.cmo \
   asmcomp/emitaux.cmo asmcomp/emit.cmo asmcomp/asmgen.cmo \
@@ -389,7 +392,6 @@ utils/config.ml: utils/config.mlp config/Makefile
 	    -e 's|%%HOST%%|$(HOST)|' \
 	    -e 's|%%TARGET%%|$(TARGET)|' \
 	    utils/config.mlp > utils/config.ml
-	@chmod -w utils/config.ml
 
 partialclean::
 	rm -f utils/config.ml
@@ -519,6 +521,14 @@ partialclean::
 
 beforedepend:: asmcomp/selection.ml
 
+asmcomp/CSE.ml: asmcomp/$(ARCH)/CSE.ml
+	cp asmcomp/$(ARCH)/CSE.ml asmcomp/CSE.ml
+
+partialclean::
+	rm -f asmcomp/CSE.ml
+
+beforedepend:: asmcomp/CSE.ml
+
 asmcomp/reload.ml: asmcomp/$(ARCH)/reload.ml
 	cp asmcomp/$(ARCH)/reload.ml asmcomp/reload.ml
 
@@ -716,7 +726,13 @@ depend: beforedepend
 alldepend:: depend
 
 distclean:
-	./build/distclean.sh
+	$(MAKE) clean
+	rm -f boot/ocamlrun boot/ocamlrun.exe boot/camlheader boot/ocamlyacc \
+	      boot/*.cm* boot/libcamlrun.a
+	rm -f config/Makefile config/m.h config/s.h
+	rm -f tools/*.bak
+	rm -f ocaml ocamlc
+	rm -f testsuite/_log
 
 .PHONY: all backup bootstrap checkstack clean
 .PHONY: partialclean beforedepend alldepend cleanboot coldstart
diff --git a/VERSION b/VERSION
index 7bcd56547a..005c112283 100644
--- a/VERSION
+++ b/VERSION
@@ -1,4 +1,4 @@
-4.02.0+dev4-2014-04-03
+4.03.0+dev1-2014-07-21
 
 # The version string is the first line of this file.
 # It must be in the format described in stdlib/sys.mli
diff --git a/asmcomp/.ignore b/asmcomp/.ignore
index 31d00178a0..8c24e74ad1 100644
--- a/asmcomp/.ignore
+++ b/asmcomp/.ignore
@@ -4,3 +4,4 @@ proc.ml
 selection.ml
 reload.ml
 scheduling.ml
+CSE.ml
diff --git a/asmcomp/CSEgen.ml b/asmcomp/CSEgen.ml
new file mode 100644
index 0000000000..8cd23b0a9b
--- /dev/null
+++ b/asmcomp/CSEgen.ml
@@ -0,0 +1,322 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Gallium, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 2014 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.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* Common subexpression elimination by value numbering over extended
+   basic blocks. *)
+
+open Mach
+
+type valnum = int
+
+(* We maintain sets of equations of the form
+       valnums = operation(valnums)
+   plus a mapping from registers to valnums (value numbers). *)
+
+type rhs = operation * valnum array
+
+module Equations =
+  Map.Make(struct type t = rhs let compare = Pervasives.compare end)
+
+type numbering =
+  { num_next: int;                      (* next fresh value number *)
+    num_eqs: valnum array Equations.t;  (* mapping rhs -> valnums *)
+    num_reg: valnum Reg.Map.t }         (* mapping register -> valnum *)
+
+let empty_numbering =
+  { num_next = 0; num_eqs = Equations.empty; num_reg = Reg.Map.empty }
+
+(** Generate a fresh value number [v] and associate it to register [r].
+  Returns a pair [(n',v)] with the updated value numbering [n']. *)
+
+let fresh_valnum_reg n r =
+  let v = n.num_next in
+  ({n with num_next = v + 1; num_reg = Reg.Map.add r v n.num_reg}, v)
+
+(* Same, for a set of registers [rs]. *)
+
+let array_fold_transf (f: numbering -> 'a -> numbering * 'b) n (a: 'a array)
+                      : numbering * 'b array =
+  match Array.length a with
+  | 0 -> (n, [||])
+  | 1 -> let (n', b) = f n a.(0) in (n', [|b|])
+  | l -> let b = Array.make l 0 and n = ref n in
+         for i = 0 to l - 1 do
+           let (n', x) = f !n a.(i) in
+           b.(i) <- x; n := n'
+         done;
+         (!n, b)
+
+let fresh_valnum_regs n rs =
+  array_fold_transf fresh_valnum_reg n rs
+
+(** [valnum_reg n r] returns the value number for the contents of
+  register [r].  If none exists, a fresh value number is returned
+  and associated with register [r].  The possibly updated numbering
+  is also returned.  [valnum_regs] is similar, but for an array of
+  registers. *)
+
+let valnum_reg n r =
+  try
+    (n, Reg.Map.find r n.num_reg)
+  with Not_found ->
+    fresh_valnum_reg n r
+
+let valnum_regs n rs =
+  array_fold_transf valnum_reg n rs
+
+(* Look up the set of equations for an equation with the given rhs.
+   Return [Some res] if there is one, where [res] is the lhs. *)
+
+let find_equation n rhs =
+  try
+    Some(Equations.find rhs n.num_eqs)
+  with Not_found ->
+    None
+
+(* Find a register containing the given value number. *)
+
+let find_reg_containing n v =
+  Reg.Map.fold (fun r v' res -> if v' = v then Some r else res)
+               n.num_reg None
+
+(* Find a set of registers containing the given value numbers. *)
+
+let find_regs_containing n vs =
+  match Array.length vs with
+  | 0 -> Some [||]
+  | 1 -> begin match find_reg_containing n vs.(0) with
+         | None -> None
+         | Some r -> Some [|r|]
+         end
+  | l -> let rs = Array.make l Reg.dummy in
+         begin try
+           for i = 0 to l - 1 do
+             match find_reg_containing n vs.(i) with
+             | None -> raise Exit
+             | Some r -> rs.(i) <- r
+           done;
+           Some rs
+         with Exit ->
+           None
+         end
+
+(* Associate the given value number to the given result register,
+   without adding new equations. *)
+
+let set_known_reg n r v =
+  { n with num_reg = Reg.Map.add r v n.num_reg }
+
+(* Associate the given value numbers to the given result registers,
+   without adding new equations. *)
+
+let array_fold2 f n a1 a2 =
+  let l = Array.length a1 in
+  assert (l = Array.length a2);
+  let n = ref n in
+  for i = 0 to l - 1 do n := f !n a1.(i) a2.(i) done;
+  !n
+
+let set_known_regs n rs vs =
+  array_fold2 set_known_reg n rs vs
+
+(* Record the effect of a move: no new equations, but the result reg
+   maps to the same value number as the argument reg. *)
+
+let set_move n src dst =
+  let (n1, v) = valnum_reg n src in
+  { n1 with num_reg = Reg.Map.add dst v n1.num_reg }
+
+(* Record the equation [fresh valnums = rhs] and associate the given
+   result registers [rs] to [fresh valnums]. *)
+
+let set_fresh_regs n rs rhs =
+  let (n1, vs) = fresh_valnum_regs n rs in
+  { n1 with num_eqs = Equations.add rhs vs n.num_eqs }
+
+(* Forget everything we know about the given result registers,
+   which are receiving unpredictable values at run-time. *)
+
+let set_unknown_regs n rs =
+  { n with num_reg = Array.fold_right Reg.Map.remove rs n.num_reg }
+
+(* Keep only the equations satisfying the given predicate. *)
+
+let filter_equations pred n =
+  { n with num_eqs = Equations.filter (fun (op,_) res -> pred op) n.num_eqs }
+
+(* Prepend a set of moves before [i] to assign [srcs] to [dsts].  *)
+
+let insert_single_move i src dst = instr_cons (Iop Imove) [|src|] [|dst|] i
+
+let insert_move srcs dsts i =
+  match Array.length srcs with
+  | 0 -> i
+  | 1 -> instr_cons (Iop Imove) srcs dsts i
+  | l -> (* Parallel move: first copy srcs into tmps one by one,
+            then copy tmps into dsts one by one *)
+         let tmps = Reg.createv_like srcs in
+         array_fold2 insert_single_move
+           (array_fold2 insert_single_move i srcs tmps) tmps dsts
+
+(* Classification of operations *)
+
+type op_class =
+  | Op_pure           (* pure arithmetic, produce one or several result *)
+  | Op_checkbound     (* checkbound-style: no result, can raise an exn *)
+  | Op_load           (* memory load *)
+  | Op_store of bool  (* memory store, false = init, true = assign *)
+  | Op_other   (* anything else that does not allocate nor store in memory *)
+
+class cse_generic = object (self)
+
+(* Default classification of operations.  Can be overriden in
+   processor-specific files to classify specific operations better. *)
+
+method class_of_operation op =
+  match op with
+  | Imove | Ispill | Ireload -> assert false   (* treated specially *)
+  | Iconst_int _ | Iconst_float _ | Iconst_symbol _
+  | Iconst_blockheader _ -> Op_pure
+  | Icall_ind | Icall_imm _ | Itailcall_ind | Itailcall_imm _
+  | Iextcall _ -> assert false                 (* treated specially *)
+  | Istackoffset _ -> Op_other
+  | Iload(_,_) -> Op_load
+  | Istore(_,_,asg) -> Op_store asg
+  | Ialloc _ -> assert false                   (* treated specially *)
+  | Iintop(Icheckbound) -> Op_checkbound
+  | Iintop _ -> Op_pure
+  | Iintop_imm(Icheckbound, _) -> Op_checkbound
+  | Iintop_imm(_, _) -> Op_pure
+  | Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf
+  | Ifloatofint | Iintoffloat -> Op_pure
+  | Ispecific _ -> Op_other
+
+(* Operations that are so cheap that it isn't worth factoring them. *)
+
+method is_cheap_operation op =
+  match op with
+  | Iconst_int _ | Iconst_blockheader _ -> true
+  | _ -> false
+
+(* Forget all equations involving memory loads.  Performed after a
+   non-initializing store *)
+
+method private kill_loads n =
+  filter_equations (fun o -> self#class_of_operation o <> Op_load) n
+
+(* Perform CSE on the given instruction [i] and its successors.
+   [n] is the value numbering current at the beginning of [i]. *)
+
+method private cse n i =
+  match i.desc with
+  | Iend | Ireturn | Iop(Itailcall_ind) | Iop(Itailcall_imm _)
+  | Iexit _ | Iraise _ ->
+      i
+  | Iop (Imove | Ispill | Ireload) ->
+      (* For moves, we associate the same value number to the result reg
+         as to the argument reg. *)
+      let n1 = set_move n i.arg.(0) i.res.(0) in
+      {i with next = self#cse n1 i.next}
+  | Iop (Icall_ind | Icall_imm _ | Iextcall _) ->
+      (* For function calls, we should at least forget:
+         - equations involving memory loads, since the callee can
+           perform arbitrary memory stores;
+         - equations involving arithmetic operations that can
+           produce bad pointers into the heap (see below for Ialloc);
+         - mappings from hardware registers to value numbers,
+           since the callee does not preserve these registers.
+         That doesn't leave much usable information: checkbounds
+         could be kept, but won't be usable for CSE as one of their
+         arguments is always a memory load.  For simplicity, we
+         just forget everything. *)
+      {i with next = self#cse empty_numbering i.next}
+  | Iop (Ialloc _) ->
+      (* For allocations, we must avoid extending the live range of a
+         pseudoregister across the allocation if this pseudoreg can
+         contain a value that looks like a pointer into the heap but
+         is not a pointer to the beginning of a Caml object.  PR#6484
+         is an example of such a value (a derived pointer into a
+         block).  In the absence of more precise typing information,
+         we just forget everything. *)
+       {i with next = self#cse empty_numbering i.next}
+  | Iop op ->
+      begin match self#class_of_operation op with
+      | Op_pure | Op_checkbound | Op_load ->
+          let (n1, varg) = valnum_regs n i.arg in
+          let n2 = set_unknown_regs n1 (Proc.destroyed_at_oper i.desc) in
+          begin match find_equation n1 (op, varg) with
+          | Some vres ->
+              (* This operation was computed earlier. *)
+              (* Are there registers that hold the results computed earlier? *)
+              begin match find_regs_containing n1 vres with
+              | Some res when (not (self#is_cheap_operation op))
+                           && (not (Proc.regs_are_volatile res)) ->
+                  (* We can replace res <- op args with r <- move res,
+                     provided res are stable (non-volatile) registers.
+                     If the operation is very cheap to compute, e.g.
+                     an integer constant, don't bother. *)
+                  let n3 = set_known_regs n1 i.res vres in
+                  (* This is n1 above and not n2 because the move
+                     does not destroy any regs *)
+                  insert_move res i.res (self#cse n3 i.next)
+              | _ ->
+                  (* We already computed the operation but lost its
+                     results.  Associate the result registers to
+                     the result valnums of the previous operation. *)
+                  let n3 = set_known_regs n2 i.res vres in
+                  {i with next = self#cse n3 i.next}
+              end
+          | None ->
+              (* This operation produces a result we haven't seen earlier. *)
+              let n3 = set_fresh_regs n2 i.res (op, varg) in
+              {i with next = self#cse n3 i.next}
+          end
+      | Op_store false | Op_other ->
+          (* An initializing store or an "other" operation do not invalidate
+             any equations, but we do not know anything about the results. *)
+         let n1 = set_unknown_regs n (Proc.destroyed_at_oper i.desc) in
+         let n2 = set_unknown_regs n1 i.res in
+         {i with next = self#cse n2 i.next}
+      | Op_store true ->
+          (* A non-initializing store can invalidate
+             anything we know about prior loads. *)
+         let n1 = set_unknown_regs n (Proc.destroyed_at_oper i.desc) in
+         let n2 = set_unknown_regs n1 i.res in
+         let n3 = self#kill_loads n2 in
+         {i with next = self#cse n3 i.next}
+      end
+  (* For control structures, we set the numbering to empty at every
+     join point, but propagate the current numbering across fork points. *)
+  | Iifthenelse(test, ifso, ifnot) ->
+     let n1 = set_unknown_regs n (Proc.destroyed_at_oper i.desc) in
+      {i with desc = Iifthenelse(test, self#cse n1 ifso, self#cse n1 ifnot);
+              next = self#cse empty_numbering i.next}
+  | Iswitch(index, cases) ->
+     let n1 = set_unknown_regs n (Proc.destroyed_at_oper i.desc) in
+      {i with desc = Iswitch(index, Array.map (self#cse n1) cases);
+              next = self#cse empty_numbering i.next}
+  | Iloop(body) ->
+      {i with desc = Iloop(self#cse empty_numbering body);
+              next = self#cse empty_numbering i.next}
+  | Icatch(nfail, body, handler) ->
+      {i with desc = Icatch(nfail, self#cse n body,
+                            self#cse empty_numbering handler);
+              next = self#cse empty_numbering i.next}
+  | Itrywith(body, handler) ->
+      {i with desc = Itrywith(self#cse n body,
+                              self#cse empty_numbering handler);
+              next = self#cse empty_numbering i.next}
+
+method fundecl f =
+  {f with fun_body = self#cse empty_numbering f.fun_body}
+
+end
diff --git a/asmcomp/CSEgen.mli b/asmcomp/CSEgen.mli
new file mode 100644
index 0000000000..ffea33891c
--- /dev/null
+++ b/asmcomp/CSEgen.mli
@@ -0,0 +1,38 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Gallium, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 2014 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.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* Common subexpression elimination by value numbering over extended
+   basic blocks. *)
+
+type op_class =
+  | Op_pure     (* pure, produce one result *)
+  | Op_checkbound     (* checkbound-style: no result, can raise an exn *)
+  | Op_load           (* memory load *)
+  | Op_store of bool  (* memory store, false = init, true = assign *)
+  | Op_other   (* anything else that does not allocate nor store in memory *)
+
+class cse_generic : object
+  (* The following methods can be overriden to handle processor-specific
+     operations. *)
+
+  method class_of_operation: Mach.operation -> op_class
+
+  method is_cheap_operation: Mach.operation -> bool
+    (* Operations that are so cheap that it isn't worth factoring them. *)
+
+  (* The following method is the entry point and should not be overridden *)
+  method fundecl: Mach.fundecl -> Mach.fundecl
+
+end
+
+
+
diff --git a/asmcomp/amd64/CSE.ml b/asmcomp/amd64/CSE.ml
new file mode 100644
index 0000000000..6c9b76e822
--- /dev/null
+++ b/asmcomp/amd64/CSE.ml
@@ -0,0 +1,39 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Gallium, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 2014 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.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* CSE for the AMD64 *)
+
+open Arch
+open Mach
+open CSEgen
+
+class cse = object (self)
+
+inherit cse_generic as super
+
+method! class_of_operation op =
+  match op with
+  | Ispecific spec ->
+    begin match spec with
+    | Ilea _ -> Op_pure
+    | Istore_int(_, _, is_asg) | Istore_symbol(_, _, is_asg) -> Op_store is_asg
+    | Ioffset_loc(_, _) -> Op_store true
+    | Ifloatarithmem _ | Ifloatsqrtf _ -> Op_load
+    | Ibswap _ | Isqrtf -> super#class_of_operation op
+    end
+  | _ -> super#class_of_operation op
+
+end
+
+let fundecl f =
+  (new cse)#fundecl f
+
diff --git a/asmcomp/amd64/arch.ml b/asmcomp/amd64/arch.ml
index b0a5ffb8b7..3741dd74bc 100644
--- a/asmcomp/amd64/arch.ml
+++ b/asmcomp/amd64/arch.ml
@@ -33,8 +33,8 @@ type addressing_mode =
 
 type specific_operation =
     Ilea of addressing_mode             (* "lea" gives scaled adds *)
-  | Istore_int of nativeint * addressing_mode (* Store an integer constant *)
-  | Istore_symbol of string * addressing_mode (* Store a symbol *)
+  | Istore_int of nativeint * addressing_mode * bool (* Store an integer constant *)
+  | Istore_symbol of string * addressing_mode * bool (* Store a symbol *)
   | Ioffset_loc of int * addressing_mode (* Add a constant to a location *)
   | Ifloatarithmem of float_operation * addressing_mode
                                        (* Float arith operation with memory *)
@@ -101,10 +101,14 @@ let print_addressing printreg addr ppf arg =
 let print_specific_operation printreg op ppf arg =
   match op with
   | Ilea addr -> print_addressing printreg addr ppf arg
-  | Istore_int(n, addr) ->
-      fprintf ppf "[%a] := %nd" (print_addressing printreg addr) arg n
-  | Istore_symbol(lbl, addr) ->
-      fprintf ppf "[%a] := \"%s\"" (print_addressing printreg addr) arg lbl
+  | Istore_int(n, addr, is_assign) ->
+      fprintf ppf "[%a] := %nd %s"
+         (print_addressing printreg addr) arg n
+         (if is_assign then "(assign)" else "(init)")
+  | Istore_symbol(lbl, addr, is_assign) ->
+      fprintf ppf "[%a] := \"%s\" %s"
+         (print_addressing printreg addr) arg lbl
+         (if is_assign then "(assign)" else "(init)")
   | Ioffset_loc(n, addr) ->
       fprintf ppf "[%a] +:= %i" (print_addressing printreg addr) arg n
   | Isqrtf ->
diff --git a/asmcomp/amd64/emit.mlp b/asmcomp/amd64/emit.mlp
index bdcc3a18d3..b576ece983 100644
--- a/asmcomp/amd64/emit.mlp
+++ b/asmcomp/amd64/emit.mlp
@@ -335,15 +335,16 @@ let output_epilogue f =
 
 (* Floating-point constants *)
 
-let float_constants = ref ([] : (string * int) list)
+let float_constants = ref ([] : (int64 * int) list)
 
 let add_float_constant cst =
+  let repr = Int64.bits_of_float cst in
   try
-    List.assoc cst !float_constants
+    List.assoc repr !float_constants
   with
     Not_found ->
       let lbl = new_label() in
-      float_constants := (cst, lbl) :: !float_constants;
+      float_constants := (repr, lbl) :: !float_constants;
       lbl
 
 let emit_float_constant (cst, lbl) =
@@ -382,12 +383,12 @@ let emit_instr fallthrough i =
           `	movq	${emit_nativeint n}, {emit_reg i.res.(0)}\n`
         else
           `	movabsq	${emit_nativeint n}, {emit_reg i.res.(0)}\n`
-    | Lop(Iconst_float s) ->
-        begin match Int64.bits_of_float (float_of_string s) with
+    | Lop(Iconst_float f) ->
+        begin match Int64.bits_of_float f with
         | 0x0000_0000_0000_0000L ->       (* +0.0 *)
           `	xorpd	{emit_reg i.res.(0)}, {emit_reg i.res.(0)}\n`
         | _ ->
-          let lbl = add_float_constant s in
+          let lbl = add_float_constant f in
           `	movsd	{emit_label lbl}(%rip), {emit_reg i.res.(0)}\n`
         end
     | Lop(Iconst_symbol s) ->
@@ -448,7 +449,7 @@ let emit_instr fallthrough i =
           | Double | Double_u ->
             `	movsd	{emit_addressing addr i.arg 0}, {emit_reg dest}\n`
         end
-    | Lop(Istore(chunk, addr)) ->
+    | Lop(Istore(chunk, addr, _)) ->
         begin match chunk with
           | Word ->
             `	movq	{emit_reg i.arg.(0)}, {emit_addressing addr i.arg 1}\n`
@@ -541,9 +542,9 @@ let emit_instr fallthrough i =
         `	cvttsd2siq	{emit_reg i.arg.(0)}, {emit_reg i.res.(0)}\n`
     | Lop(Ispecific(Ilea addr)) ->
         `	leaq	{emit_addressing addr i.arg 0}, {emit_reg i.res.(0)}\n`
-    | Lop(Ispecific(Istore_int(n, addr))) ->
+    | Lop(Ispecific(Istore_int(n, addr, _))) ->
         `	movq	${emit_nativeint n}, {emit_addressing addr i.arg 0}\n`
-    | Lop(Ispecific(Istore_symbol(s, addr))) ->
+    | Lop(Ispecific(Istore_symbol(s, addr, _))) ->
         assert (not !pic_code && not !Clflags.dlcode);
         `	movq	${emit_symbol s}, {emit_addressing addr i.arg 0}\n`
     | Lop(Ispecific(Ioffset_loc(n, addr))) ->
@@ -764,9 +765,9 @@ let emit_item = function
   | Cint n ->
       `	.quad	{emit_nativeint n}\n`
   | Csingle f ->
-      emit_float32_directive ".long" f
+      emit_float32_directive ".long" (Int32.bits_of_float f)
   | Cdouble f ->
-      emit_float64_directive ".quad" f
+      emit_float64_directive ".quad" (Int64.bits_of_float f)
   | Csymbol_address s ->
       `	.quad	{emit_symbol s}\n`
   | Clabel_address lbl ->
diff --git a/asmcomp/amd64/emit_nt.mlp b/asmcomp/amd64/emit_nt.mlp
index 77156b8f01..f14e69cd38 100644
--- a/asmcomp/amd64/emit_nt.mlp
+++ b/asmcomp/amd64/emit_nt.mlp
@@ -53,9 +53,10 @@ let slot_offset loc cl =
       else !stack_offset + (num_stack_slots.(0) + n) * 8
   | Outgoing n -> n
 
-(* Output a 32 bit integer in hex *)
+(* Output a 32 or 64 bit integer in hex *)
 
 let emit_int32 n = emit_printf "0%lxh" n
+let emit_int64 n = emit_printf "0%Lxh" n
 
 (* Symbols *)
 
@@ -321,36 +322,20 @@ let output_epilogue () =
 
 (* Floating-point constants *)
 
-let float_constants = ref ([] : (string * int) list)
+let float_constants = ref ([] : (int64 * int) list)
 
 let add_float_constant cst =
+  let repr = Int64.bits_of_float cst in
   try
-    List.assoc cst !float_constants
+    List.assoc repr !float_constants
   with
     Not_found ->
       let lbl = new_label() in
-      float_constants := (cst, lbl) :: !float_constants;
+      float_constants := (repr, lbl) :: !float_constants;
       lbl
 
-let emit_float s =
-  (* MASM doesn't like floating-point constants such as 2e9.
-     Turn them into 2.0e9. *)
-  let pos_e = ref (-1) and pos_dot = ref (-1) in
-  for i = 0 to String.length s - 1 do
-    match s.[i] with
-      'e'|'E' -> pos_e := i
-    | '.'     -> pos_dot := i
-    | _       -> ()
-  done;
-  if !pos_dot < 0 && !pos_e >= 0 then begin
-    emit_string (String.sub s 0 !pos_e);
-    emit_string ".0";
-    emit_string (String.sub s !pos_e (String.length s - !pos_e))
-  end else
-    emit_string s
-
 let emit_float_constant (cst, lbl) =
-  `{emit_label lbl}     REAL8   {emit_float cst}\n`
+  `{emit_label lbl}	QWORD	{emit_int64 cst}\n`
 
 let emit_movabs reg n =
   (* force ml64 to use mov reg, imm64 instruction *)
@@ -389,12 +374,12 @@ let emit_instr fallthrough i =
           `	mov	{emit_reg32 i.res.(0)}, {emit_nativeint n}\n`
         else
           emit_movabs i.res.(0) n
-    | Lop(Iconst_float s) ->
-        begin match Int64.bits_of_float (float_of_string s) with
+    | Lop(Iconst_float f) ->
+        begin match Int64.bits_of_float f with
         | 0x0000_0000_0000_0000L ->       (* +0.0 *)
           `	xorpd	{emit_reg i.res.(0)}, {emit_reg i.res.(0)}\n`
         | _ ->
-          let lbl = add_float_constant s in
+          let lbl = add_float_constant f in
           `	movsd	{emit_reg i.res.(0)}, {emit_label lbl}\n`
         end
     | Lop(Iconst_symbol s) ->
@@ -458,7 +443,7 @@ let emit_instr fallthrough i =
           | Double | Double_u ->
             `	movsd	{emit_reg dest}, REAL8 PTR {emit_addressing addr i.arg 0}\n`
         end
-    | Lop(Istore(chunk, addr)) ->
+    | Lop(Istore(chunk, addr, _)) ->
         begin match chunk with
           | Word ->
             `	mov	QWORD PTR {emit_addressing addr i.arg 1}, {emit_reg i.arg.(0)}\n`
@@ -547,9 +532,9 @@ let emit_instr fallthrough i =
         `	cvttsd2si	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}\n`
     | Lop(Ispecific(Ilea addr)) ->
         `	lea	{emit_reg i.res.(0)}, {emit_addressing addr i.arg 0}\n`
-    | Lop(Ispecific(Istore_int(n, addr))) ->
+    | Lop(Ispecific(Istore_int(n, addr, _))) ->
         `	mov	QWORD PTR {emit_addressing addr i.arg 0}, {emit_nativeint n}\n`
-    | Lop(Ispecific(Istore_symbol(s, addr))) ->
+    | Lop(Ispecific(Istore_symbol(s, addr, _))) ->
         assert (not !pic_code);
 	add_used_symbol s;
         `	mov	QWORD PTR {emit_addressing addr i.arg 0}, OFFSET {emit_symbol s}\n`
@@ -721,9 +706,9 @@ let emit_item = function
   | Cint n ->
       `	QWORD	{emit_nativeint n}\n`
   | Csingle f ->
-      `	REAL4	{emit_float f}\n`
+      `	DWORD	{emit_int32 (Int32.bits_of_float f)}\n`
   | Cdouble f ->
-      `	REAL8	{emit_float f}\n`
+      `	QWORD	{emit_int64 (Int64.bits_of_float f)}\n`
   | Csymbol_address s ->
       add_used_symbol s;
       `	QWORD	{emit_symbol s}\n`
diff --git a/asmcomp/amd64/proc.ml b/asmcomp/amd64/proc.ml
index b6e0fa94ab..e3f0d2950a 100644
--- a/asmcomp/amd64/proc.ml
+++ b/asmcomp/amd64/proc.ml
@@ -239,6 +239,10 @@ let loc_external_arguments =
 
 let loc_exn_bucket = rax
 
+(* Volatile registers: none *)
+
+let regs_are_volatile rs = false
+
 (* Registers destroyed by operations *)
 
 let destroyed_at_c_call =
@@ -259,7 +263,7 @@ let destroyed_at_oper = function
   | Iop(Iextcall(_, false)) -> destroyed_at_c_call
   | Iop(Iintop(Idiv | Imod)) | Iop(Iintop_imm((Idiv | Imod), _))
         -> [| rax; rdx |]
-  | Iop(Istore(Single, _)) -> [| rxmm15 |]
+  | Iop(Istore(Single, _, _)) -> [| rxmm15 |]
   | Iop(Ialloc _ | Iintop(Imulh | Icomp _) | Iintop_imm((Icomp _), _))
         -> [| rax |]
   | Iswitch(_, _) -> [| rax; rdx |]
@@ -290,10 +294,21 @@ let max_register_pressure = function
     if fp then [| 10; 16 |] else [| 11; 16 |]
   | Ialloc _ | Iintop(Icomp _) | Iintop_imm((Icomp _), _) ->
     if fp then [| 11; 16 |] else [| 12; 16 |]
-  | Istore(Single, _) ->
+  | Istore(Single, _, _) ->
     if fp then [| 12; 15 |] else [| 13; 15 |]
   | _ -> if fp then [| 12; 16 |] else [| 13; 16 |]
 
+(* Pure operations (without any side effect besides updating their result
+   registers). *)
+
+let op_is_pure = function
+  | Icall_ind | Icall_imm _ | Itailcall_ind | Itailcall_imm _
+  | Iextcall _ | Istackoffset _ | Istore _ | Ialloc _
+  | Iintop(Icheckbound) | Iintop_imm(Icheckbound, _) -> false
+  | Ispecific(Ilea _) -> true
+  | Ispecific _ -> false
+  | _ -> true
+
 (* Layout of the stack frame *)
 
 let num_stack_slots = [| 0; 0 |]
diff --git a/asmcomp/amd64/selection.ml b/asmcomp/amd64/selection.ml
index 5e6afbcabf..fa7fe66c05 100644
--- a/asmcomp/amd64/selection.ml
+++ b/asmcomp/amd64/selection.ml
@@ -152,20 +152,20 @@ method select_addressing chunk exp =
     | Ascaledadd(e1, e2, scale) ->
         (Iindexed2scaled(scale, d), Ctuple[e1; e2])
 
-method! select_store addr exp =
+method! select_store is_assign addr exp =
   match exp with
     Cconst_int n when self#is_immediate n ->
-      (Ispecific(Istore_int(Nativeint.of_int n, addr)), Ctuple [])
+      (Ispecific(Istore_int(Nativeint.of_int n, addr, is_assign)), Ctuple [])
   | (Cconst_natint n | Cconst_blockheader n) when self#is_immediate_natint n ->
-      (Ispecific(Istore_int(n, addr)), Ctuple [])
+      (Ispecific(Istore_int(n, addr, is_assign)), Ctuple [])
   | Cconst_pointer n when self#is_immediate n ->
-      (Ispecific(Istore_int(Nativeint.of_int n, addr)), Ctuple [])
+      (Ispecific(Istore_int(Nativeint.of_int n, addr, is_assign)), Ctuple [])
   | Cconst_natpointer n when self#is_immediate_natint n ->
-      (Ispecific(Istore_int(n, addr)), Ctuple [])
+      (Ispecific(Istore_int(n, addr, is_assign)), Ctuple [])
   | Cconst_symbol s when not (!pic_code || !Clflags.dlcode) ->
-      (Ispecific(Istore_symbol(s, addr)), Ctuple [])
+      (Ispecific(Istore_symbol(s, addr, is_assign)), Ctuple [])
   | _ ->
-      super#select_store addr exp
+      super#select_store is_assign addr exp
 
 method! select_operation op args =
   match op with
diff --git a/asmcomp/arm/CSE.ml b/asmcomp/arm/CSE.ml
new file mode 100644
index 0000000000..00282f1f55
--- /dev/null
+++ b/asmcomp/arm/CSE.ml
@@ -0,0 +1,38 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Gallium, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 2014 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.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* CSE for ARM *)
+
+open Arch
+open Mach
+open CSEgen
+
+class cse = object (self)
+
+inherit cse_generic as super
+
+method! class_of_operation op =
+  match op with
+  | Ispecific(Ishiftcheckbound _) -> Op_checkbound
+  | Ispecific _ -> Op_pure
+  | _ -> super#class_of_operation op
+
+method! is_cheap_operation op =
+  match op with
+  | Iconst_int n | Iconst_blockheader n -> n <= 255n && n >= 0n
+  | _ -> false
+
+end
+
+let fundecl f =
+  (new cse)#fundecl f
+
diff --git a/asmcomp/arm/emit.mlp b/asmcomp/arm/emit.mlp
index 2f20ecf61a..61035b85fd 100644
--- a/asmcomp/arm/emit.mlp
+++ b/asmcomp/arm/emit.mlp
@@ -273,7 +273,7 @@ let function_name = ref ""
 (* Entry point for tail recursive calls *)
 let tailrec_entry_point = ref 0
 (* Pending floating-point literals *)
-let float_literals = ref ([] : (string * label) list)
+let float_literals = ref ([] : (int64 * label) list)
 (* Pending relative references to the global offset table *)
 let gotrel_literals = ref ([] : (label * label) list)
 (* Pending symbol literals *)
@@ -283,12 +283,13 @@ let num_literals = ref 0
 
 (* Label a floating-point literal *)
 let float_literal f =
+  let repr = Int64.bits_of_float f in
   try
-    List.assoc f !float_literals
+    List.assoc repr !float_literals
   with Not_found ->
     let lbl = new_label() in
     num_literals := !num_literals + 2;
-    float_literals := (f, lbl) :: !float_literals;
+    float_literals := (repr, lbl) :: !float_literals;
     lbl
 
 (* Label a GOTREL literal *)
@@ -314,7 +315,7 @@ let emit_literals() =
     `	.align	3\n`;
     List.iter
       (fun (f, lbl) ->
-        `{emit_label lbl}:	.double	{emit_string f}\n`)
+        `{emit_label lbl}:`; emit_float64_split_directive ".long" f)
       !float_literals;
     float_literals := []
   end;
@@ -390,8 +391,7 @@ let emit_instr i =
     | Lop(Iconst_int n | Iconst_blockheader n) ->
         emit_intconst i.res.(0) (Nativeint.to_int32 n)
     | Lop(Iconst_float f) when !fpu = Soft ->
-        `	@ {emit_string f}\n`;
-        let bits = Int64.bits_of_float (float_of_string f) in
+        let bits = Int64.bits_of_float f in
         let high_bits = Int64.to_int32 (Int64.shift_right_logical bits 32)
         and low_bits = Int64.to_int32 bits in
         if is_immediate low_bits || is_immediate high_bits then begin
@@ -406,7 +406,7 @@ let emit_instr i =
         end
     | Lop(Iconst_float f) when !fpu = VFPv2 ->
         let lbl = float_literal f in
-        `	fldd	{emit_reg i.res.(0)}, {emit_label lbl} @ {emit_string f}\n`;
+        `	fldd	{emit_reg i.res.(0)}, {emit_label lbl}\n`;
         1
     | Lop(Iconst_float f) ->
         let encode imm =
@@ -425,12 +425,12 @@ let emit_instr i =
               let ex = ((ex + 3) land 0x07) lxor 0x04 in
               Some((sg lsl 7) lor (ex lsl 4) lor mn)
           end in
-        begin match encode (Int64.bits_of_float (float_of_string f)) with
+        begin match encode (Int64.bits_of_float f) with
           None ->
             let lbl = float_literal f in
-            `	fldd	{emit_reg i.res.(0)}, {emit_label lbl} @ {emit_string f}\n`
+            `	fldd	{emit_reg i.res.(0)}, {emit_label lbl}\n`
         | Some imm8 ->
-            `	fconstd	{emit_reg i.res.(0)}, #{emit_int imm8} @ {emit_string f}\n`
+            `	fconstd	{emit_reg i.res.(0)}, #{emit_int imm8}\n`
         end; 1
     | Lop(Iconst_symbol s) ->
         emit_load_symbol_addr i.res.(0) s
@@ -508,10 +508,10 @@ let emit_instr i =
           | Double_u -> "fldd"
           | _ (* 32-bit quantities *) -> "ldr" in
         `	{emit_string instr}	{emit_reg r}, {emit_addressing addr i.arg 0}\n`; 1
-    | Lop(Istore(Single, addr)) when !fpu >= VFPv2 ->
+    | Lop(Istore(Single, addr, _)) when !fpu >= VFPv2 ->
         `	fcvtsd	s14, {emit_reg i.arg.(0)}\n`;
         `	fsts	s14, {emit_addressing addr i.arg 1}\n`; 2
-    | Lop(Istore((Double | Double_u), addr)) when !fpu = Soft ->
+    | Lop(Istore((Double | Double_u), addr, _)) when !fpu = Soft ->
         (* Use STM or STRD if possible *)
         begin match i.arg.(0), i.arg.(1), addr with
           {loc = Reg rt}, {loc = Reg rt2}, Iindexed 0
@@ -525,7 +525,7 @@ let emit_instr i =
             `	str	{emit_reg i.arg.(0)}, {emit_addressing addr i.arg 2}\n`;
             `	str	{emit_reg i.arg.(1)}, {emit_addressing addr' i.arg 2}\n`; 2
         end
-    | Lop(Istore(size, addr)) ->
+    | Lop(Istore(size, addr, _)) ->
         let r = i.arg.(0) in
         let instr =
           match size with
@@ -874,8 +874,8 @@ let emit_item = function
   | Cint16 n -> `	.short	{emit_int n}\n`
   | Cint32 n -> `	.long	{emit_int32 (Nativeint.to_int32 n)}\n`
   | Cint n -> `	.long	{emit_int32 (Nativeint.to_int32 n)}\n`
-  | Csingle f -> `	.single	{emit_string f}\n`
-  | Cdouble f -> `	.double	{emit_string f}\n`
+  | Csingle f -> emit_float32_directive ".long" (Int32.bits_of_float f)
+  | Cdouble f -> emit_float64_split_directive ".long" (Int64.bits_of_float f)
   | Csymbol_address s -> `	.word	{emit_symbol s}\n`
   | Clabel_address lbl -> `	.word	{emit_data_label lbl}\n`
   | Cstring s -> emit_string_directive "	.ascii  " s
diff --git a/asmcomp/arm/proc.ml b/asmcomp/arm/proc.ml
index a16c35a226..99c59dd9cb 100644
--- a/asmcomp/arm/proc.ml
+++ b/asmcomp/arm/proc.ml
@@ -166,13 +166,17 @@ let loc_external_results res =
 
 let loc_exn_bucket = phys_reg 0
 
+(* Volatile registers: none *)
+
+let regs_are_volatile rs = false
+
 (* Registers destroyed by operations *)
 
 let destroyed_at_alloc =            (* r0-r6, d0-d15 preserved *)
   Array.of_list (List.map
                    phys_reg
                    [7;8;
-                    116;116;118;119;120;121;122;123;
+                    116;117;118;119;120;121;122;123;
                     124;125;126;127;128;129;130;131])
 
 let destroyed_at_c_call =
@@ -183,12 +187,12 @@ let destroyed_at_c_call =
                         [0;1;2;3;8;
                          100;101;102;103;104;105;106;107;
                          108;109;110;111;112;113;114;115;
-                         116;116;118;119;120;121;122;123;
+                         116;117;118;119;120;121;122;123;
                          124;125;126;127;128;129;130;131]
                     | EABI_HF ->    (* r4-r7, d8-d15 preserved *)
                         [0;1;2;3;8;
                          100;101;102;103;104;105;106;107;
-                         116;116;118;119;120;121;122;123;
+                         116;117;118;119;120;121;122;123;
                          124;125;126;127;128;129;130;131]))
 
 let destroyed_at_oper = function
@@ -203,7 +207,7 @@ let destroyed_at_oper = function
       [| phys_reg 3; phys_reg 8 |]  (* r3 and r12 destroyed *)
   | Iop(Iintop Imulh) when !arch < ARMv6 ->
       [| phys_reg 8 |]              (* r12 destroyed *)
-  | Iop(Iintoffloat | Ifloatofint | Iload(Single, _) | Istore(Single, _)) ->
+  | Iop(Iintoffloat | Ifloatofint | Iload(Single, _) | Istore(Single, _, _)) ->
       [| phys_reg 107 |]            (* d7 (s14-s15) destroyed *)
   | _ -> [||]
 
@@ -222,9 +226,19 @@ let max_register_pressure = function
   | Ialloc _ -> if abi = EABI then [| 7; 0; 0 |] else [| 7; 8; 8 |]
   | Iconst_symbol _ when !pic_code -> [| 7; 16; 32 |]
   | Iintoffloat | Ifloatofint
-  | Iload(Single, _) | Istore(Single, _) -> [| 9; 15; 31 |]
+  | Iload(Single, _) | Istore(Single, _, _) -> [| 9; 15; 31 |]
   | _ -> [| 9; 16; 32 |]
 
+(* Pure operations (without any side effect besides updating their result
+   registers). *)
+
+let op_is_pure = function
+  | Icall_ind | Icall_imm _ | Itailcall_ind | Itailcall_imm _
+  | Iextcall _ | Istackoffset _ | Istore _ | Ialloc _
+  | Iintop(Icheckbound) | Iintop_imm(Icheckbound, _)
+  | Ispecific(Ishiftcheckbound _) -> false
+  | _ -> true
+
 (* Layout of the stack *)
 
 let num_stack_slots = [| 0; 0; 0 |]
diff --git a/asmcomp/arm64/CSE.ml b/asmcomp/arm64/CSE.ml
new file mode 100644
index 0000000000..359e57eb55
--- /dev/null
+++ b/asmcomp/arm64/CSE.ml
@@ -0,0 +1,38 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Gallium, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 2014 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.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* CSE for ARM64 *)
+
+open Arch
+open Mach
+open CSEgen
+
+class cse = object (self)
+
+inherit cse_generic as super
+
+method! class_of_operation op =
+  match op with
+  | Ispecific(Ishiftcheckbound _) -> Op_checkbound
+  | Ispecific _ -> Op_pure
+  | _ -> super#class_of_operation op
+
+method! is_cheap_operation op =
+  match op with
+  | Iconst_int n | Iconst_blockheader n -> n <= 65535n && n >= 0n
+  | _ -> false
+
+end
+
+let fundecl f =
+  (new cse)#fundecl f
+
diff --git a/asmcomp/arm64/emit.mlp b/asmcomp/arm64/emit.mlp
index 4a3e3cd7b4..734bd23e15 100644
--- a/asmcomp/arm64/emit.mlp
+++ b/asmcomp/arm64/emit.mlp
@@ -286,7 +286,7 @@ let emit_literals() =
     `	.align	3\n`;
     List.iter
       (fun (f, lbl) ->
-        `{emit_label lbl}:	.quad	`; emit_printf "0x%Lx\n" f)
+        `{emit_label lbl}:`; emit_float64_directive ".quad" f)
       !float_literals;
     float_literals := []
   end
@@ -326,15 +326,15 @@ let emit_instr i =
     | Lop(Iconst_int n | Iconst_blockheader n) ->
         emit_intconst i.res.(0) n
     | Lop(Iconst_float f) ->
-        let b = Int64.bits_of_float(float_of_string f) in
+        let b = Int64.bits_of_float f in
         if b = 0L then
-          `	fmov	{emit_reg i.res.(0)}, xzr	/* {emit_string f} */\n`
+          `	fmov	{emit_reg i.res.(0)}, xzr\n`
         else if is_immediate_float b then
-          `	fmov	{emit_reg i.res.(0)}, #{emit_printf "0x%Lx" b}	/* {emit_string f} */\n`
+          `	fmov	{emit_reg i.res.(0)}, #{emit_printf "0x%Lx" b}\n`
         else begin
           let lbl = float_literal b in
           `	adrp	{emit_reg reg_tmp1}, {emit_label lbl}\n`;
-          `	ldr	{emit_reg i.res.(0)}, [{emit_reg reg_tmp1}, #:lo12:{emit_label lbl}]	/* {emit_string f} */\n`
+          `	ldr	{emit_reg i.res.(0)}, [{emit_reg reg_tmp1}, #:lo12:{emit_label lbl}]\n`
         end
     | Lop(Iconst_symbol s) ->
         emit_load_symbol_addr i.res.(0) s
@@ -388,7 +388,7 @@ let emit_instr i =
         | Word | Double | Double_u ->
             `	ldr	{emit_reg dst}, {emit_addressing addr base}\n`
         end
-    | Lop(Istore(size, addr)) ->
+    | Lop(Istore(size, addr, _)) ->
         let src = i.arg.(0) in
         let base =
           match addr with
@@ -644,7 +644,7 @@ let fundecl fundecl =
   call_gc_sites := [];
   bound_error_sites := [];
   `	.text\n`;
-  `	.align	2\n`;
+  `	.align	3\n`;
   `	.globl	{emit_symbol fundecl.fun_name}\n`;
   `	.type	{emit_symbol fundecl.fun_name}, %function\n`;
   `{emit_symbol fundecl.fun_name}:\n`;
@@ -675,8 +675,8 @@ let emit_item = function
   | Cint16 n -> `	.short	{emit_int n}\n`
   | Cint32 n -> `	.long	{emit_nativeint n}\n`
   | Cint n -> `	.quad	{emit_nativeint n}\n`
-  | Csingle f -> emit_float32_directive ".long" f
-  | Cdouble f -> emit_float64_directive ".quad" f
+  | Csingle f -> emit_float32_directive ".long" (Int32.bits_of_float f)
+  | Cdouble f -> emit_float64_directive ".quad" (Int64.bits_of_float f)
   | Csymbol_address s -> `	.quad	{emit_symbol s}\n`
   | Clabel_address lbl -> `	.quad	{emit_data_label lbl}\n`
   | Cstring s -> emit_string_directive "	.ascii  " s
@@ -685,6 +685,7 @@ let emit_item = function
 
 let data l =
   `	.data\n`;
+  `	.align 3\n`;
   List.iter emit_item l
 
 (* Beginning / end of an assembly file *)
diff --git a/asmcomp/arm64/proc.ml b/asmcomp/arm64/proc.ml
index b52c2fd8ae..9e19d477f5 100644
--- a/asmcomp/arm64/proc.ml
+++ b/asmcomp/arm64/proc.ml
@@ -160,6 +160,10 @@ let loc_external_results res =
 
 let loc_exn_bucket = phys_reg 0
 
+(* Volatile registers: none *)
+
+let regs_are_volatile rs = false
+
 (* Registers destroyed by operations *)
 
 let destroyed_at_c_call =
@@ -177,7 +181,7 @@ let destroyed_at_oper = function
       destroyed_at_c_call
   | Iop(Ialloc _) ->
       [| reg_x15 |]
-  | Iop(Iintoffloat | Ifloatofint | Iload(Single, _) | Istore(Single, _)) ->
+  | Iop(Iintoffloat | Ifloatofint | Iload(Single, _) | Istore(Single, _, _)) ->
       [| reg_d7 |]            (* d7 / s7 destroyed *)
   | _ -> [||]
 
@@ -194,9 +198,19 @@ let max_register_pressure = function
   | Iextcall(_, _) -> [| 10; 8 |]
   | Ialloc _ -> [| 25; 32 |]
   | Iintoffloat | Ifloatofint
-  | Iload(Single, _) | Istore(Single, _) -> [| 26; 31 |]
+  | Iload(Single, _) | Istore(Single, _, _) -> [| 26; 31 |]
   | _ -> [| 26; 32 |]
 
+(* Pure operations (without any side effect besides updating their result
+   registers). *)
+
+let op_is_pure = function
+  | Icall_ind | Icall_imm _ | Itailcall_ind | Itailcall_imm _
+  | Iextcall _ | Istackoffset _ | Istore _ | Ialloc _
+  | Iintop(Icheckbound) | Iintop_imm(Icheckbound, _)
+  | Ispecific(Ishiftcheckbound _) -> false
+  | _ -> true
+
 (* Layout of the stack *)
 
 let num_stack_slots = [| 0; 0 |]
diff --git a/asmcomp/asmgen.ml b/asmcomp/asmgen.ml
index 34283875cb..311bb029b2 100644
--- a/asmcomp/asmgen.ml
+++ b/asmcomp/asmgen.ml
@@ -64,7 +64,10 @@ let compile_fundecl (ppf : formatter) fd_cmm =
   ++ pass_dump_if ppf dump_selection "After instruction selection"
   ++ Comballoc.fundecl
   ++ pass_dump_if ppf dump_combine "After allocation combining"
+  ++ CSE.fundecl
+  ++ pass_dump_if ppf dump_cse "After CSE"
   ++ liveness ppf
+  ++ Deadcode.fundecl
   ++ pass_dump_if ppf dump_live "Liveness analysis"
   ++ Spill.fundecl
   ++ liveness ppf
diff --git a/asmcomp/asmlink.ml b/asmcomp/asmlink.ml
index 5842f44eb4..f0ca7ba296 100644
--- a/asmcomp/asmlink.ml
+++ b/asmcomp/asmlink.ml
@@ -33,31 +33,37 @@ exception Error of error
 (* Consistency check between interfaces and implementations *)
 
 let crc_interfaces = Consistbl.create ()
+let interfaces = ref ([] : string list)
 let crc_implementations = Consistbl.create ()
-let extra_implementations = ref ([] : string list)
+let implementations = ref ([] : string list)
 let implementations_defined = ref ([] : (string * string) list)
 let cmx_required = ref ([] : string list)
 
 let check_consistency file_name unit crc =
   begin try
     List.iter
-      (fun (name, crc) ->
-        if name = unit.ui_name
-        then Consistbl.set crc_interfaces name crc file_name
-        else Consistbl.check crc_interfaces name crc file_name)
+      (fun (name, crco) ->
+        interfaces := name :: !interfaces;
+        match crco with
+          None -> ()
+        | Some crc ->
+            if name = unit.ui_name
+            then Consistbl.set crc_interfaces name crc file_name
+            else Consistbl.check crc_interfaces name crc file_name)
       unit.ui_imports_cmi
   with Consistbl.Inconsistency(name, user, auth) ->
     raise(Error(Inconsistent_interface(name, user, auth)))
   end;
   begin try
     List.iter
-      (fun (name, crc) ->
-        if crc <> cmx_not_found_crc then
-          Consistbl.check crc_implementations name crc file_name
-        else if List.mem name !cmx_required then
-          raise(Error(Missing_cmx(file_name, name)))
-        else
-          extra_implementations := name :: !extra_implementations)
+      (fun (name, crco) ->
+        implementations := name :: !implementations;
+        match crco with
+            None ->
+              if List.mem name !cmx_required then
+                raise(Error(Missing_cmx(file_name, name)))
+          | Some crc ->
+              Consistbl.check crc_implementations name crc file_name)
       unit.ui_imports_cmx
   with Consistbl.Inconsistency(name, user, auth) ->
     raise(Error(Inconsistent_implementation(name, user, auth)))
@@ -67,6 +73,7 @@ let check_consistency file_name unit crc =
     raise (Error(Multiple_definition(unit.ui_name, file_name, source)))
   with Not_found -> ()
   end;
+  implementations := unit.ui_name :: !implementations;
   Consistbl.set crc_implementations unit.ui_name crc file_name;
   implementations_defined :=
     (unit.ui_name, file_name) :: !implementations_defined;
@@ -74,13 +81,9 @@ let check_consistency file_name unit crc =
     cmx_required := unit.ui_name :: !cmx_required
 
 let extract_crc_interfaces () =
-  Consistbl.extract crc_interfaces
+  Consistbl.extract !interfaces crc_interfaces
 let extract_crc_implementations () =
-  List.fold_left
-    (fun ncl n ->
-      if List.mem_assoc n ncl then ncl else (n, cmx_not_found_crc) :: ncl)
-    (Consistbl.extract crc_implementations)
-    !extra_implementations
+  Consistbl.extract !implementations crc_implementations
 
 (* Add C objects and options and "custom" info from a library descriptor.
    See bytecomp/bytelink.ml for comments on the order of C objects. *)
@@ -214,10 +217,14 @@ let make_startup_file ppf filename units_list =
     (Cmmgen.globals_map
        (List.map
           (fun (unit,_,crc) ->
-             try (unit.ui_name, List.assoc unit.ui_name unit.ui_imports_cmi,
-                  crc,
-                  unit.ui_defines)
-             with Not_found -> assert false)
+               let intf_crc =
+                 try
+                   match List.assoc unit.ui_name unit.ui_imports_cmi with
+                     None -> assert false
+                   | Some crc -> crc
+                 with Not_found -> assert false
+               in
+                 (unit.ui_name, intf_crc, crc, unit.ui_defines))
           units_list));
   compile_phrase(Cmmgen.data_segment_table ("_startup" :: name_list));
   compile_phrase(Cmmgen.code_segment_table ("_startup" :: name_list));
@@ -397,3 +404,14 @@ let () =
       | Error err -> Some (Location.error_of_printer_file report_error err)
       | _ -> None
     )
+
+let reset () =
+  Consistbl.clear crc_interfaces;
+  Consistbl.clear crc_implementations;
+  implementations_defined := [];
+  cmx_required := [];
+  interfaces := [];
+  implementations := []
+
+
+
diff --git a/asmcomp/asmlink.mli b/asmcomp/asmlink.mli
index 1cf9e302c1..60a2111e1c 100644
--- a/asmcomp/asmlink.mli
+++ b/asmcomp/asmlink.mli
@@ -20,9 +20,10 @@ val link_shared: formatter -> string list -> string -> unit
 
 val call_linker_shared: string list -> string -> unit
 
+val reset : unit -> unit
 val check_consistency: string -> Cmx_format.unit_infos -> Digest.t -> unit
-val extract_crc_interfaces: unit -> (string * Digest.t) list
-val extract_crc_implementations: unit -> (string * Digest.t) list
+val extract_crc_interfaces: unit -> (string * Digest.t option) list
+val extract_crc_implementations: unit -> (string * Digest.t option) list
 
 type error =
     File_not_found of string
diff --git a/asmcomp/asmpackager.ml b/asmcomp/asmpackager.ml
index a8fcfe7896..d900df1e14 100644
--- a/asmcomp/asmpackager.ml
+++ b/asmcomp/asmpackager.ml
@@ -130,7 +130,7 @@ let build_package_cmx members cmxfile =
           List.flatten (List.map (fun info -> info.ui_defines) units) @
           [ui.ui_symbol];
       ui_imports_cmi =
-          (ui.ui_name, Env.crc_of_unit ui.ui_name) ::
+          (ui.ui_name, Some (Env.crc_of_unit ui.ui_name)) ::
           filter(Asmlink.extract_crc_interfaces());
       ui_imports_cmx =
           filter(Asmlink.extract_crc_implementations());
@@ -161,7 +161,7 @@ let package_object_files ppf files targetcmx
 
 (* The entry point *)
 
-let package_files ppf files targetcmx =
+let package_files ppf initial_env files targetcmx =
   let files =
     List.map
       (fun f ->
@@ -177,7 +177,8 @@ let package_files ppf files targetcmx =
   (* Set the name of the current compunit *)
   Compilenv.reset ?packname:!Clflags.for_package targetname;
   try
-    let coercion = Typemod.package_units files targetcmi targetname in
+    let coercion =
+      Typemod.package_units initial_env files targetcmi targetname in
     package_object_files ppf files targetcmx targetobj targetname coercion
   with x ->
     remove_file targetcmx; remove_file targetobj;
diff --git a/asmcomp/asmpackager.mli b/asmcomp/asmpackager.mli
index 65272b7ed7..4d47f5c283 100644
--- a/asmcomp/asmpackager.mli
+++ b/asmcomp/asmpackager.mli
@@ -13,7 +13,7 @@
 (* "Package" a set of .cmx/.o files into one .cmx/.o file having the
    original compilation units as sub-modules. *)
 
-val package_files: Format.formatter -> string list -> string -> unit
+val package_files: Format.formatter -> Env.t -> string list -> string -> unit
 
 type error =
     Illegal_renaming of string * string * string
diff --git a/asmcomp/clambda.ml b/asmcomp/clambda.ml
index 3586296e4f..ed96f218bf 100644
--- a/asmcomp/clambda.ml
+++ b/asmcomp/clambda.ml
@@ -19,12 +19,12 @@ open Lambda
 type function_label = string
 
 type ustructured_constant =
-  | Uconst_float of string
+  | Uconst_float of float
   | Uconst_int32 of int32
   | Uconst_int64 of int64
   | Uconst_nativeint of nativeint
   | Uconst_block of int * uconstant list
-  | Uconst_float_array of string list
+  | Uconst_float_array of float list
   | Uconst_string of string
 
 and uconstant =
@@ -74,7 +74,9 @@ type function_description =
   { fun_label: function_label;          (* Label of direct entry point *)
     fun_arity: int;                     (* Number of arguments *)
     mutable fun_closed: bool;           (* True if environment not used *)
-    mutable fun_inline: (Ident.t list * ulambda) option }
+    mutable fun_inline: (Ident.t list * ulambda) option;
+    mutable fun_float_const_prop: bool  (* Can propagate FP consts *)
+  }
 
 (* Approximation of values *)
 
@@ -84,3 +86,65 @@ type value_approximation =
   | Value_unknown
   | Value_const of uconstant
   | Value_global_field of string * int
+
+(* Comparison functions for constants.  We must not use Pervasives.compare
+   because it compares "0.0" and "-0.0" equal.  (PR#6442) *)
+
+let compare_floats x1 x2 =
+  Int64.compare (Int64.bits_of_float x1) (Int64.bits_of_float x2)
+
+let rec compare_float_lists l1 l2 =
+  match l1, l2 with
+  | [], [] -> 0
+  | [], _::_ -> -1
+  | _::_, [] -> 1
+  | h1::t1, h2::t2 ->
+      let c = compare_floats h1 h2 in
+      if c <> 0 then c else compare_float_lists t1 t2
+
+let compare_constants c1 c2 =
+  match c1, c2 with
+  | Uconst_ref(lbl1, c1), Uconst_ref(lbl2, c2) -> String.compare lbl1 lbl2
+      (* Same labels -> same constants.
+         Different labels -> different constants, even if the contents
+           match, because of string constants that must not be
+           reshared. *)
+  | Uconst_int n1, Uconst_int n2 -> Pervasives.compare n1 n2
+  | Uconst_ptr n1, Uconst_ptr n2 -> Pervasives.compare n1 n2
+  | Uconst_ref _, _ -> -1
+  | Uconst_int _, Uconst_ref _ -> 1
+  | Uconst_int _, Uconst_ptr _ -> -1
+  | Uconst_ptr _, _ -> 1
+
+let rec compare_constant_lists l1 l2 =
+  match l1, l2 with
+  | [], [] -> 0
+  | [], _::_ -> -1
+  | _::_, [] -> 1
+  | h1::t1, h2::t2 ->
+      let c = compare_constants h1 h2 in
+      if c <> 0 then c else compare_constant_lists t1 t2
+
+let rank_structured_constant = function
+  | Uconst_float _ -> 0
+  | Uconst_int32 _ -> 1
+  | Uconst_int64 _ -> 2
+  | Uconst_nativeint _ -> 3
+  | Uconst_block _ -> 4
+  | Uconst_float_array _ -> 5
+  | Uconst_string _ -> 6
+
+let compare_structured_constants c1 c2 =
+  match c1, c2 with
+  | Uconst_float x1, Uconst_float x2 -> compare_floats x1 x2
+  | Uconst_int32 x1, Uconst_int32 x2 -> Int32.compare x1 x2
+  | Uconst_int64 x1, Uconst_int64 x2 -> Int64.compare x1 x2
+  | Uconst_nativeint x1, Uconst_nativeint x2 -> Nativeint.compare x1 x2
+  | Uconst_block(t1, l1), Uconst_block(t2, l2) -> 
+      let c = t1 - t2 (* no overflow possible here *) in
+      if c <> 0 then c else compare_constant_lists l1 l2
+  | Uconst_float_array l1, Uconst_float_array l2 ->
+      compare_float_lists l1 l2
+  | Uconst_string s1, Uconst_string s2 -> String.compare s1 s2
+  | _, _ -> rank_structured_constant c1 - rank_structured_constant c2
+                (* no overflow possible here *)
diff --git a/asmcomp/clambda.mli b/asmcomp/clambda.mli
index e751326fe4..fc7a14d1e2 100644
--- a/asmcomp/clambda.mli
+++ b/asmcomp/clambda.mli
@@ -19,12 +19,12 @@ open Lambda
 type function_label = string
 
 type ustructured_constant =
-  | Uconst_float of string
+  | Uconst_float of float
   | Uconst_int32 of int32
   | Uconst_int64 of int64
   | Uconst_nativeint of nativeint
   | Uconst_block of int * uconstant list
-  | Uconst_float_array of string list
+  | Uconst_float_array of float list
   | Uconst_string of string
 
 and uconstant =
@@ -74,7 +74,9 @@ type function_description =
   { fun_label: function_label;          (* Label of direct entry point *)
     fun_arity: int;                     (* Number of arguments *)
     mutable fun_closed: bool;           (* True if environment not used *)
-    mutable fun_inline: (Ident.t list * ulambda) option }
+    mutable fun_inline: (Ident.t list * ulambda) option;
+    mutable fun_float_const_prop: bool  (* Can propagate FP consts *)
+  }
 
 (* Approximation of values *)
 
@@ -84,3 +86,10 @@ type value_approximation =
   | Value_unknown
   | Value_const of uconstant
   | Value_global_field of string * int
+
+(* Comparison functions for constants *)
+
+val compare_structured_constants:
+        ustructured_constant -> ustructured_constant -> int
+val compare_constants:
+        uconstant -> uconstant -> int
diff --git a/asmcomp/closure.ml b/asmcomp/closure.ml
index eff35ce4f2..9d3749d44d 100644
--- a/asmcomp/closure.ml
+++ b/asmcomp/closure.ml
@@ -245,14 +245,15 @@ let rec is_pure_clambda = function
   | Uprim(p, args, _) -> List.for_all is_pure_clambda args
   | _ -> false
 
-(* Simplify primitive operations on integers *)
+(* Simplify primitive operations on known arguments *)
 
 let make_const c = (Uconst c, Value_const c)
-
+let make_const_ref c =
+  make_const(Uconst_ref(Compilenv.new_structured_constant ~shared:true c, c))
 let make_const_int n = make_const (Uconst_int n)
 let make_const_ptr n = make_const (Uconst_ptr n)
 let make_const_bool b = make_const_ptr(if b then 1 else 0)
-let make_comparison cmp (x: int) (y: int) =
+let make_comparison cmp x y =
   make_const_bool
     (match cmp with
        Ceq -> x = y
@@ -261,71 +262,187 @@ let make_comparison cmp (x: int) (y: int) =
      | Cgt -> x > y
      | Cle -> x <= y
      | Cge -> x >= y)
+let make_const_float n = make_const_ref (Uconst_float n)
+let make_const_natint n = make_const_ref (Uconst_nativeint n)
+let make_const_int32 n = make_const_ref (Uconst_int32 n)
+let make_const_int64 n = make_const_ref (Uconst_int64 n)
+
+(* The [fpc] parameter is true if constant propagation of
+   floating-point computations is allowed *)
 
-let simplif_int_prim_pure p (args, approxs) dbg =
+let simplif_arith_prim_pure fpc p (args, approxs) dbg =
+  let default = (Uprim(p, args, dbg), Value_unknown) in
   match approxs with
-    [Value_const (Uconst_int x)] ->
+  (* int (or enumerated type) *)
+  | [ Value_const(Uconst_int n1 | Uconst_ptr n1) ] ->
       begin match p with
-        Pidentity -> make_const_int x
-      | Pnegint -> make_const_int (-x)
-      | Pbswap16 ->
-         make_const_int (((x land 0xff) lsl 8) lor
-                         ((x land 0xff00) lsr 8))
-      | Poffsetint y -> make_const_int (x + y)
-      | _ -> (Uprim(p, args, dbg), Value_unknown)
+      | Pnot -> make_const_bool (n1 = 0)
+      | Pnegint -> make_const_int (- n1)
+      | Poffsetint n -> make_const_int (n + n1)
+      | Pfloatofint when fpc -> make_const_float (float_of_int n1)
+      | Pbintofint Pnativeint -> make_const_natint (Nativeint.of_int n1)
+      | Pbintofint Pint32 -> make_const_int32 (Int32.of_int n1)
+      | Pbintofint Pint64 -> make_const_int64 (Int64.of_int n1)
+      | Pbswap16 -> make_const_int (((n1 land 0xff) lsl 8)
+                                    lor ((n1 land 0xff00) lsr 8))
+      | _ -> default
       end
-  | [Value_const (Uconst_int x); Value_const (Uconst_int y)] ->
+  (* int (or enumerated type), int (or enumerated type) *)
+  | [ Value_const(Uconst_int n1 | Uconst_ptr n1);
+      Value_const(Uconst_int n2 | Uconst_ptr n2) ] ->
       begin match p with
-        Paddint -> make_const_int(x + y)
-      | Psubint -> make_const_int(x - y)
-      | Pmulint -> make_const_int(x * y)
-      | Pdivint when y <> 0 -> make_const_int(x / y)
-      | Pmodint when y <> 0 -> make_const_int(x mod y)
-      | Pandint -> make_const_int(x land y)
-      | Porint -> make_const_int(x lor y)
-      | Pxorint -> make_const_int(x lxor y)
-      | Plslint -> make_const_int(x lsl y)
-      | Plsrint -> make_const_int(x lsr y)
-      | Pasrint -> make_const_int(x asr y)
-      | Pintcomp cmp -> make_comparison cmp x y
-      | _ -> (Uprim(p, args, dbg), Value_unknown)
+      | Psequand -> make_const_bool (n1 <> 0 && n2 <> 0)
+      | Psequor -> make_const_bool (n1 <> 0 || n2 <> 0)
+      | Paddint -> make_const_int (n1 + n2)
+      | Psubint -> make_const_int (n1 - n2)
+      | Pmulint -> make_const_int (n1 * n2)
+      | Pdivint when n2 <> 0 -> make_const_int (n1 / n2)
+      | Pmodint when n2 <> 0 -> make_const_int (n1 mod n2)
+      | Pandint -> make_const_int (n1 land n2)
+      | Porint -> make_const_int (n1 lor n2)
+      | Pxorint -> make_const_int (n1 lxor n2)
+      | Plslint when 0 <= n2 && n2 < 8 * Arch.size_int ->
+          make_const_int (n1 lsl n2)
+      | Plsrint when 0 <= n2 && n2 < 8 * Arch.size_int ->
+          make_const_int (n1 lsr n2)
+      | Pasrint when 0 <= n2 && n2 < 8 * Arch.size_int ->
+          make_const_int (n1 asr n2)
+      | Pintcomp c -> make_comparison c n1 n2
+      | _ -> default
       end
-  | [Value_const (Uconst_ptr x)] ->
+  (* float *)
+  | [Value_const(Uconst_ref(_, Uconst_float n1))] when fpc ->
       begin match p with
-        Pidentity -> make_const_ptr x
-      | Pnot -> make_const_bool(x = 0)
-      | Pisint -> make_const_bool true
-      | Pctconst c ->
-          begin
-            match c with
-            | Big_endian -> make_const_bool Arch.big_endian
-            | Word_size -> make_const_int (8*Arch.size_int)
-            | Ostype_unix -> make_const_bool (Sys.os_type = "Unix")
-            | Ostype_win32 -> make_const_bool (Sys.os_type = "Win32")
-            | Ostype_cygwin -> make_const_bool (Sys.os_type = "Cygwin")
-          end
-      | _ -> (Uprim(p, args, dbg), Value_unknown)
+      | Pintoffloat -> make_const_int (int_of_float n1)
+      | Pnegfloat -> make_const_float (-. n1)
+      | Pabsfloat -> make_const_float (abs_float n1)
+      | _ -> default
       end
-  | [Value_const (Uconst_ptr x); Value_const (Uconst_ptr y)] ->
+  (* float, float *)
+  | [Value_const(Uconst_ref(_, Uconst_float n1));
+     Value_const(Uconst_ref(_, Uconst_float n2))] when fpc ->
       begin match p with
-        Psequand -> make_const_bool(x <> 0 && y <> 0)
-      | Psequor  -> make_const_bool(x <> 0 || y <> 0)
-      | Pintcomp cmp -> make_comparison cmp x y
-      | _ -> (Uprim(p, args, dbg), Value_unknown)
+      | Paddfloat -> make_const_float (n1 +. n2)
+      | Psubfloat -> make_const_float (n1 -. n2)
+      | Pmulfloat -> make_const_float (n1 *. n2)
+      | Pdivfloat -> make_const_float (n1 /. n2)
+      | Pfloatcomp c  -> make_comparison c n1 n2
+      | _ -> default
       end
-  | [Value_const (Uconst_ptr x); Value_const (Uconst_int y)] ->
+  (* nativeint *)
+  | [Value_const(Uconst_ref(_, Uconst_nativeint n))] ->
       begin match p with
-      | Pintcomp cmp -> make_comparison cmp x y
-      | _ -> (Uprim(p, args, dbg), Value_unknown)
+      | Pintofbint Pnativeint -> make_const_int (Nativeint.to_int n)
+      | Pcvtbint(Pnativeint, Pint32) -> make_const_int32 (Nativeint.to_int32 n)
+      | Pcvtbint(Pnativeint, Pint64) -> make_const_int64 (Int64.of_nativeint n)
+      | Pnegbint Pnativeint -> make_const_natint (Nativeint.neg n)
+      | _ -> default
       end
-  | [Value_const (Uconst_int x); Value_const (Uconst_ptr y)] ->
+  (* nativeint, nativeint *)
+  | [Value_const(Uconst_ref(_, Uconst_nativeint n1));
+     Value_const(Uconst_ref(_, Uconst_nativeint n2))] ->
       begin match p with
-      | Pintcomp cmp -> make_comparison cmp x y
-      | _ -> (Uprim(p, args, dbg), Value_unknown)
+      | Paddbint Pnativeint -> make_const_natint (Nativeint.add n1 n2)
+      | Psubbint Pnativeint -> make_const_natint (Nativeint.sub n1 n2)
+      | Pmulbint Pnativeint -> make_const_natint (Nativeint.mul n1 n2)
+      | Pdivbint Pnativeint when n2 <> 0n ->
+          make_const_natint (Nativeint.div n1 n2)
+      | Pmodbint Pnativeint when n2 <> 0n ->
+          make_const_natint (Nativeint.rem n1 n2)
+      | Pandbint Pnativeint -> make_const_natint (Nativeint.logand n1 n2)
+      | Porbint Pnativeint ->  make_const_natint (Nativeint.logor n1 n2)
+      | Pxorbint Pnativeint -> make_const_natint (Nativeint.logxor n1 n2)
+      | Pbintcomp(Pnativeint, c)  -> make_comparison c n1 n2
+      | _ -> default
+      end
+  (* nativeint, int *)
+  | [Value_const(Uconst_ref(_, Uconst_nativeint n1));
+     Value_const(Uconst_int n2)] ->
+      begin match p with
+      | Plslbint Pnativeint when 0 <= n2 && n2 < 8 * Arch.size_int ->
+          make_const_natint (Nativeint.shift_left n1 n2)
+      | Plsrbint Pnativeint when 0 <= n2 && n2 < 8 * Arch.size_int ->
+          make_const_natint (Nativeint.shift_right_logical n1 n2)
+      | Pasrbint Pnativeint when 0 <= n2 && n2 < 8 * Arch.size_int ->
+          make_const_natint (Nativeint.shift_right n1 n2)
+      | _ -> default
+      end
+  (* int32 *)
+  | [Value_const(Uconst_ref(_, Uconst_int32 n))] ->
+      begin match p with
+      | Pintofbint Pint32 -> make_const_int (Int32.to_int n)
+      | Pcvtbint(Pint32, Pnativeint) -> make_const_natint (Nativeint.of_int32 n)
+      | Pcvtbint(Pint32, Pint64) -> make_const_int64 (Int64.of_int32 n)
+      | Pnegbint Pint32 -> make_const_int32 (Int32.neg n)
+      | _ -> default
+      end
+  (* int32, int32 *)
+  | [Value_const(Uconst_ref(_, Uconst_int32 n1));
+     Value_const(Uconst_ref(_, Uconst_int32 n2))] ->
+      begin match p with
+      | Paddbint Pint32 -> make_const_int32 (Int32.add n1 n2)
+      | Psubbint Pint32 -> make_const_int32 (Int32.sub n1 n2)
+      | Pmulbint Pint32 -> make_const_int32 (Int32.mul n1 n2)
+      | Pdivbint Pint32 when n2 <> 0l -> make_const_int32 (Int32.div n1 n2)
+      | Pmodbint Pint32 when n2 <> 0l -> make_const_int32 (Int32.rem n1 n2)
+      | Pandbint Pint32 -> make_const_int32 (Int32.logand n1 n2)
+      | Porbint Pint32 -> make_const_int32 (Int32.logor n1 n2)
+      | Pxorbint Pint32 -> make_const_int32 (Int32.logxor n1 n2)
+      | Pbintcomp(Pint32, c) -> make_comparison c n1 n2
+      | _ -> default
+      end
+  (* int32, int *)
+  | [Value_const(Uconst_ref(_, Uconst_int32 n1));
+     Value_const(Uconst_int n2)] ->
+      begin match p with
+      | Plslbint Pint32 when 0 <= n2 && n2 < 32 ->
+          make_const_int32 (Int32.shift_left n1 n2)
+      | Plsrbint Pint32 when 0 <= n2 && n2 < 32 ->
+          make_const_int32 (Int32.shift_right_logical n1 n2)
+      | Pasrbint Pint32 when 0 <= n2 && n2 < 32 ->
+          make_const_int32 (Int32.shift_right n1 n2)
+      | _ -> default
       end
+  (* int64 *)
+  | [Value_const(Uconst_ref(_, Uconst_int64 n))] ->
+      begin match p with
+      | Pintofbint Pint64 -> make_const_int (Int64.to_int n)
+      | Pcvtbint(Pint64, Pint32) -> make_const_int32 (Int64.to_int32 n)
+      | Pcvtbint(Pint64, Pnativeint) -> make_const_natint (Int64.to_nativeint n)
+      | Pnegbint Pint64 -> make_const_int64 (Int64.neg n)
+      | _ -> default
+      end
+  (* int64, int64 *)
+  | [Value_const(Uconst_ref(_, Uconst_int64 n1));
+     Value_const(Uconst_ref(_, Uconst_int64 n2))] ->
+      begin match p with
+      | Paddbint Pint64 -> make_const_int64 (Int64.add n1 n2)
+      | Psubbint Pint64 -> make_const_int64 (Int64.sub n1 n2)
+      | Pmulbint Pint64 -> make_const_int64 (Int64.mul n1 n2)
+      | Pdivbint Pint64 when n2 <> 0L -> make_const_int64 (Int64.div n1 n2)
+      | Pmodbint Pint64 when n2 <> 0L -> make_const_int64 (Int64.rem n1 n2)
+      | Pandbint Pint64 -> make_const_int64 (Int64.logand n1 n2)
+      | Porbint Pint64 -> make_const_int64 (Int64.logor n1 n2)
+      | Pxorbint Pint64 -> make_const_int64 (Int64.logxor n1 n2)
+      | Pbintcomp(Pint64, c) -> make_comparison c n1 n2
+      | _ -> default
+      end
+  (* int64, int *)
+  | [Value_const(Uconst_ref(_, Uconst_int64 n1));
+     Value_const(Uconst_int n2)] ->
+      begin match p with
+      | Plslbint Pint64 when 0 <= n2 && n2 < 64 ->
+          make_const_int64 (Int64.shift_left n1 n2)
+      | Plsrbint Pint64 when 0 <= n2 && n2 < 64 ->
+          make_const_int64 (Int64.shift_right_logical n1 n2)
+      | Pasrbint Pint64 when 0 <= n2 && n2 < 64 ->
+          make_const_int64 (Int64.shift_right n1 n2)
+      | _ -> default
+      end
+  (* TODO: Pbbswap *)
+  (* Catch-all *)
   | _ ->
-      (Uprim(p, args, dbg), Value_unknown)
-
+     default
 
 let field_approx n = function
   | Value_tuple a when n < Array.length a -> a.(n)
@@ -333,8 +450,9 @@ let field_approx n = function
       Value_const (List.nth l n)
   | _ -> Value_unknown
 
-let simplif_prim_pure p (args, approxs) dbg =
+let simplif_prim_pure fpc p (args, approxs) dbg =
   match p, args, approxs with
+  (* Block construction *)
   | Pmakeblock(tag, Immutable), _, _ ->
       let field = function
         | Value_const c -> c
@@ -349,24 +467,43 @@ let simplif_prim_pure p (args, approxs) dbg =
       with Exit ->
         (Uprim(p, args, dbg), Value_tuple (Array.of_list approxs))
       end
+  (* Field access *)
   | Pfield n, _, [ Value_const(Uconst_ref(_, Uconst_block(_, l))) ]
     when n < List.length l ->
       make_const (List.nth l n)
-
-  | Pfield n, [ Uprim(Pmakeblock _, ul, _) ], [approx] ->
-      assert(n < List.length ul);
-      List.nth ul n, field_approx n approx
-
-  | Pstringlength, _, [ Value_const(Uconst_ref(_, Uconst_string s)) ]
-    ->
+  | Pfield n, [ Uprim(Pmakeblock _, ul, _) ], [approx]
+    when n < List.length ul ->
+      (List.nth ul n, field_approx n approx)
+  (* Strings *)
+  | Pstringlength, _, [ Value_const(Uconst_ref(_, Uconst_string s)) ] ->
       make_const_int (String.length s)
-
+  (* Identity *)
+  | Pidentity, [arg1], [app1] ->
+      (arg1, app1)
+  (* Kind test *)
+  | Pisint, _, [a1] ->
+      begin match a1 with
+      | Value_const(Uconst_int _ | Uconst_ptr _) -> make_const_bool true
+      | Value_const(Uconst_ref _) -> make_const_bool false
+      | Value_closure _ | Value_tuple _ -> make_const_bool false
+      | _ -> (Uprim(p, args, dbg), Value_unknown)
+      end
+  (* Compile-time constants *)
+  | Pctconst c, _, _ ->
+      begin match c with
+        | Big_endian -> make_const_bool Arch.big_endian
+        | Word_size -> make_const_int (8*Arch.size_int)
+        | Ostype_unix -> make_const_bool (Sys.os_type = "Unix")
+        | Ostype_win32 -> make_const_bool (Sys.os_type = "Win32")
+        | Ostype_cygwin -> make_const_bool (Sys.os_type = "Cygwin")
+      end
+  (* Catch-all *)
   | _ ->
-      simplif_int_prim_pure p (args, approxs) dbg
+      simplif_arith_prim_pure fpc p (args, approxs) dbg
 
-let simplif_prim p (args, approxs as args_approxs) dbg =
+let simplif_prim fpc p (args, approxs as args_approxs) dbg =
   if List.for_all is_pure_clambda args
-  then simplif_prim_pure p args_approxs dbg
+  then simplif_prim_pure fpc p args_approxs dbg
   else
     (* XXX : always return the same approxs as simplif_prim_pure? *)
     let approx =
@@ -391,15 +528,16 @@ let approx_ulam = function
     Uconst c -> Value_const c
   | _ -> Value_unknown
 
-let rec substitute sb ulam =
+let rec substitute fpc sb ulam =
   match ulam with
     Uvar v ->
       begin try Tbl.find v sb with Not_found -> ulam end
   | Uconst _ -> ulam
   | Udirect_apply(lbl, args, dbg) ->
-      Udirect_apply(lbl, List.map (substitute sb) args, dbg)
+      Udirect_apply(lbl, List.map (substitute fpc sb) args, dbg)
   | Ugeneric_apply(fn, args, dbg) ->
-      Ugeneric_apply(substitute sb fn, List.map (substitute sb) args, dbg)
+      Ugeneric_apply(substitute fpc sb fn,
+                     List.map (substitute fpc sb) args, dbg)
   | Uclosure(defs, env) ->
       (* Question: should we rename function labels as well?  Otherwise,
          there is a risk that function labels are not globally unique.
@@ -409,11 +547,12 @@ let rec substitute sb ulam =
          - When we substitute offsets for idents bound by let rec
            in [close], case [Lletrec], we discard the original
            let rec body and use only the substituted term. *)
-      Uclosure(defs, List.map (substitute sb) env)
-  | Uoffset(u, ofs) -> Uoffset(substitute sb u, ofs)
+      Uclosure(defs, List.map (substitute fpc sb) env)
+  | Uoffset(u, ofs) -> Uoffset(substitute fpc sb u, ofs)
   | Ulet(id, u1, u2) ->
       let id' = Ident.rename id in
-      Ulet(id', substitute sb u1, substitute (Tbl.add id (Uvar id') sb) u2)
+      Ulet(id', substitute fpc sb u1,
+           substitute fpc (Tbl.add id (Uvar id') sb) u2)
   | Uletrec(bindings, body) ->
       let bindings1 =
         List.map (fun (id, rhs) -> (id, Ident.rename id, rhs)) bindings in
@@ -422,57 +561,64 @@ let rec substitute sb ulam =
           (fun (id, id', _) s -> Tbl.add id (Uvar id') s)
           bindings1 sb in
       Uletrec(
-        List.map (fun (id, id', rhs) -> (id', substitute sb' rhs)) bindings1,
-        substitute sb' body)
+        List.map
+           (fun (id, id', rhs) -> (id', substitute fpc sb' rhs))
+           bindings1,
+        substitute fpc sb' body)
   | Uprim(p, args, dbg) ->
-      let sargs = List.map (substitute sb) args in
-      let (res, _) = simplif_prim p (sargs, List.map approx_ulam sargs) dbg in
+      let sargs =
+        List.map (substitute fpc sb) args in
+      let (res, _) =
+        simplif_prim fpc p (sargs, List.map approx_ulam sargs) dbg in
       res
   | Uswitch(arg, sw) ->
-      Uswitch(substitute sb arg,
+      Uswitch(substitute fpc sb arg,
               { sw with
                 us_actions_consts =
-                  Array.map (substitute sb) sw.us_actions_consts;
+                  Array.map (substitute fpc sb) sw.us_actions_consts;
                 us_actions_blocks =
-                  Array.map (substitute sb) sw.us_actions_blocks;
+                  Array.map (substitute fpc sb) sw.us_actions_blocks;
                })
   | Ustringswitch(arg,sw,d) ->
       Ustringswitch
-        (substitute sb arg,
-         List.map (fun (s,act) -> s,substitute sb act) sw,
-         Misc.may_map (substitute sb) d)
+        (substitute fpc sb arg,
+         List.map (fun (s,act) -> s,substitute fpc sb act) sw,
+         Misc.may_map (substitute fpc sb) d)
   | Ustaticfail (nfail, args) ->
-      Ustaticfail (nfail, List.map (substitute sb) args)
+      Ustaticfail (nfail, List.map (substitute fpc sb) args)
   | Ucatch(nfail, ids, u1, u2) ->
-      Ucatch(nfail, ids, substitute sb u1, substitute sb u2)
+      Ucatch(nfail, ids, substitute fpc sb u1, substitute fpc sb u2)
   | Utrywith(u1, id, u2) ->
       let id' = Ident.rename id in
-      Utrywith(substitute sb u1, id', substitute (Tbl.add id (Uvar id') sb) u2)
+      Utrywith(substitute fpc sb u1, id',
+               substitute fpc (Tbl.add id (Uvar id') sb) u2)
   | Uifthenelse(u1, u2, u3) ->
-      begin match substitute sb u1 with
+      begin match substitute fpc sb u1 with
         Uconst (Uconst_ptr n) ->
-          if n <> 0 then substitute sb u2 else substitute sb u3
+          if n <> 0 then substitute fpc sb u2 else substitute fpc sb u3
       | Uprim(Pmakeblock _, _, _) ->
-          substitute sb u2
+          substitute fpc sb u2
       | su1 ->
-          Uifthenelse(su1, substitute sb u2, substitute sb u3)
+          Uifthenelse(su1, substitute fpc sb u2, substitute fpc sb u3)
       end
-  | Usequence(u1, u2) -> Usequence(substitute sb u1, substitute sb u2)
-  | Uwhile(u1, u2) -> Uwhile(substitute sb u1, substitute sb u2)
+  | Usequence(u1, u2) ->
+      Usequence(substitute fpc sb u1, substitute fpc sb u2)
+  | Uwhile(u1, u2) ->
+      Uwhile(substitute fpc sb u1, substitute fpc sb u2)
   | Ufor(id, u1, u2, dir, u3) ->
       let id' = Ident.rename id in
-      Ufor(id', substitute sb u1, substitute sb u2, dir,
-           substitute (Tbl.add id (Uvar id') sb) u3)
+      Ufor(id', substitute fpc sb u1, substitute fpc sb u2, dir,
+           substitute fpc (Tbl.add id (Uvar id') sb) u3)
   | Uassign(id, u) ->
       let id' =
         try
           match Tbl.find id sb with Uvar i -> i | _ -> assert false
         with Not_found ->
           id in
-      Uassign(id', substitute sb u)
+      Uassign(id', substitute fpc sb u)
   | Usend(k, u1, u2, ul, dbg) ->
-      Usend(k, substitute sb u1, substitute sb u2, List.map (substitute sb) ul,
-            dbg)
+      Usend(k, substitute fpc sb u1, substitute fpc sb u2,
+            List.map (substitute fpc sb) ul, dbg)
 
 (* Perform an inline expansion *)
 
@@ -484,12 +630,12 @@ let no_effects = function
   | Uclosure _ -> true
   | u -> is_simple_argument u
 
-let rec bind_params_rec subst params args body =
+let rec bind_params_rec fpc subst params args body =
   match (params, args) with
-    ([], []) -> substitute subst body
+    ([], []) -> substitute fpc subst body
   | (p1 :: pl, a1 :: al) ->
       if is_simple_argument a1 then
-        bind_params_rec (Tbl.add p1 a1 subst) pl al body
+        bind_params_rec fpc (Tbl.add p1 a1 subst) pl al body
       else begin
         let p1' = Ident.rename p1 in
         let u1, u2 =
@@ -500,17 +646,17 @@ let rec bind_params_rec subst params args body =
               a1, Uvar p1'
         in
         let body' =
-          bind_params_rec (Tbl.add p1 u2 subst) pl al body in
+          bind_params_rec fpc (Tbl.add p1 u2 subst) pl al body in
         if occurs_var p1 body then Ulet(p1', u1, body')
         else if no_effects a1 then body'
         else Usequence(a1, body')
       end
   | (_, _) -> assert false
 
-let bind_params params args body =
+let bind_params fpc params args body =
   (* Reverse parameters and arguments to preserve right-to-left
      evaluation order (PR#2910). *)
-  bind_params_rec Tbl.empty (List.rev params) (List.rev args) body
+  bind_params_rec fpc Tbl.empty (List.rev params) (List.rev args) body
 
 (* Check if a lambda term is ``pure'',
    that is without side-effects *and* not containing function definitions *)
@@ -532,8 +678,10 @@ let direct_apply fundesc funct ufunct uargs =
     if fundesc.fun_closed then uargs else uargs @ [ufunct] in
   let app =
     match fundesc.fun_inline with
-      None -> Udirect_apply(fundesc.fun_label, app_args, Debuginfo.none)
-    | Some(params, body) -> bind_params params app_args body in
+    | None ->
+        Udirect_apply(fundesc.fun_label, app_args, Debuginfo.none)
+    | Some(params, body) ->
+        bind_params fundesc.fun_float_const_prop params app_args body in
   (* If ufunct can contain side-effects or function definitions,
      we must make sure that it is evaluated exactly once.
      If the function is not closed, we evaluate ufunct as part of the
@@ -648,14 +796,14 @@ let rec close fenv cenv = function
             str (Uconst_block (tag, List.map transl fields))
         | Const_float_array sl ->
             (* constant float arrays are really immutable *)
-            str (Uconst_float_array sl)
+            str (Uconst_float_array (List.map float_of_string sl))
         | Const_immstring s ->
             str (Uconst_string s)
         | Const_base (Const_string (s, _)) ->
               (* strings (even literal ones) are mutable! *)
               (* of course, the empty string is really immutable *)
             str ~shared:false(*(String.length s = 0)*) (Uconst_string s)
-        | Const_base(Const_float x) -> str (Uconst_float x)
+        | Const_base(Const_float x) -> str (Uconst_float (float_of_string x))
         | Const_base(Const_int32 x) -> str (Uconst_int32 x)
         | Const_base(Const_int64 x) -> str (Uconst_int64 x)
         | Const_base(Const_nativeint x) -> str (Uconst_nativeint x)
@@ -749,7 +897,7 @@ let rec close fenv cenv = function
             (fun (id, pos, approx) sb ->
               Tbl.add id (Uoffset(Uvar clos_ident, pos)) sb)
             infos Tbl.empty in
-        (Ulet(clos_ident, clos, substitute sb ubody),
+        (Ulet(clos_ident, clos, substitute !Clflags.float_const_prop sb ubody),
          approx)
       end else begin
         (* General case: recursive definition of values *)
@@ -757,7 +905,7 @@ let rec close fenv cenv = function
           [] -> ([], fenv)
         | (id, lam) :: rem ->
             let (udefs, fenv_body) = clos_defs rem in
-            let (ulam, approx) = close fenv cenv lam in
+            let (ulam, approx) = close_named fenv cenv id lam in
             ((id, ulam) :: udefs, Tbl.add id approx fenv_body) in
         let (udefs, fenv_body) = clos_defs defs in
         let (ubody, approx) = close fenv_body cenv body in
@@ -785,7 +933,8 @@ let rec close fenv cenv = function
       (Uprim(Praise k, [ulam], Debuginfo.from_raise ev),
        Value_unknown)
   | Lprim(p, args) ->
-      simplif_prim p (close_list_approx fenv cenv args) Debuginfo.none
+      simplif_prim !Clflags.float_const_prop
+                   p (close_list_approx fenv cenv args) Debuginfo.none
   | Lswitch(arg, sw) ->
       let fn fail =
         let (uarg, _) = close fenv cenv arg in
@@ -925,7 +1074,8 @@ and close_functions fenv cenv fun_defs =
               {fun_label = label;
                fun_arity = (if kind = Tupled then -arity else arity);
                fun_closed = initially_closed;
-               fun_inline = None } in
+               fun_inline = None;
+               fun_float_const_prop = !Clflags.float_const_prop } in
             (id, params, body, fundesc)
         | (_, _) -> fatal_error "Closure.close_functions")
       fun_defs in
@@ -1129,10 +1279,14 @@ let collect_exported_structured_constants a =
   in
   approx a
 
+let reset () =
+  global_approx := [||];
+  function_nesting_depth := 0
+
 (* The entry point *)
 
 let intro size lam =
-  function_nesting_depth := 0;
+  reset ();
   let id = Compilenv.make_symbol None in
   global_approx := Array.init size (fun i -> Value_global_field (id, i));
   Compilenv.set_global_approx(Value_tuple !global_approx);
diff --git a/asmcomp/closure.mli b/asmcomp/closure.mli
index e7bccbca60..2db6e16336 100644
--- a/asmcomp/closure.mli
+++ b/asmcomp/closure.mli
@@ -13,3 +13,4 @@
 (* Introduction of closures, uncurrying, recognition of direct calls *)
 
 val intro: int -> Lambda.lambda -> Clambda.ulambda
+val reset : unit -> unit
diff --git a/asmcomp/cmm.ml b/asmcomp/cmm.ml
index 9a5f3ec6b8..67ee3445fd 100644
--- a/asmcomp/cmm.ml
+++ b/asmcomp/cmm.ml
@@ -85,7 +85,7 @@ type operation =
 type expression =
     Cconst_int of int
   | Cconst_natint of nativeint
-  | Cconst_float of string
+  | Cconst_float of float
   | Cconst_symbol of string
   | Cconst_pointer of int
   | Cconst_natpointer of nativeint
@@ -118,8 +118,8 @@ type data_item =
   | Cint16 of int
   | Cint32 of nativeint
   | Cint of nativeint
-  | Csingle of string
-  | Cdouble of string
+  | Csingle of float
+  | Cdouble of float
   | Csymbol_address of string
   | Clabel_address of int
   | Cstring of string
diff --git a/asmcomp/cmm.mli b/asmcomp/cmm.mli
index be2bd41457..97b8d40971 100644
--- a/asmcomp/cmm.mli
+++ b/asmcomp/cmm.mli
@@ -71,7 +71,7 @@ type operation =
 type expression =
     Cconst_int of int
   | Cconst_natint of nativeint
-  | Cconst_float of string
+  | Cconst_float of float
   | Cconst_symbol of string
   | Cconst_pointer of int
   | Cconst_natpointer of nativeint
@@ -104,8 +104,8 @@ type data_item =
   | Cint16 of int
   | Cint32 of nativeint
   | Cint of nativeint
-  | Csingle of string
-  | Cdouble of string
+  | Csingle of float
+  | Cdouble of float
   | Csymbol_address of string
   | Clabel_address of int
   | Cstring of string
diff --git a/asmcomp/cmmgen.ml b/asmcomp/cmmgen.ml
index 10c4303f82..b68b6a616a 100644
--- a/asmcomp/cmmgen.ml
+++ b/asmcomp/cmmgen.ml
@@ -38,6 +38,8 @@ let bind_nonvar name arg fn =
   | Cconst_blockheader _ -> fn arg
   | _ -> let id = Ident.create name in Clet(id, arg, fn (Cvar id))
 
+let caml_black = Nativeint.shift_left (Nativeint.of_int 3) 8  (* cf. byterun/gc.h *)
+
 (* Block headers. Meaning of the tag field: see stdlib/obj.ml *)
 
 let floatarray_tag = Cconst_int Obj.double_array_tag
@@ -45,7 +47,12 @@ let floatarray_tag = Cconst_int Obj.double_array_tag
 let block_header tag sz =
   Nativeint.add (Nativeint.shift_left (Nativeint.of_int sz) 10)
                 (Nativeint.of_int tag)
-let closure_header sz = block_header Obj.closure_tag sz
+(* Static data corresponding to "value"s must be marked black in case we are
+   in no-naked-pointers mode.  See [caml_darken] and the code below that emits
+   structured constants and static module definitions. *)
+let black_block_header tag sz = Nativeint.logor (block_header tag sz) caml_black
+let white_closure_header sz = block_header Obj.closure_tag sz
+let black_closure_header sz = black_block_header Obj.closure_tag sz
 let infix_header ofs = block_header Obj.infix_tag ofs
 let float_header = block_header Obj.double_tag (size_float / size_addr)
 let floatarray_header len =
@@ -59,7 +66,7 @@ let boxedintnat_header = block_header Obj.custom_tag 2
 let alloc_block_header tag sz = Cconst_blockheader(block_header tag sz)
 let alloc_float_header = Cconst_blockheader(float_header)
 let alloc_floatarray_header len = Cconst_blockheader(floatarray_header len)
-let alloc_closure_header sz = Cconst_blockheader(closure_header sz)
+let alloc_closure_header sz = Cconst_blockheader(white_closure_header sz)
 let alloc_infix_header ofs = Cconst_blockheader(infix_header ofs)
 let alloc_boxedint32_header = Cconst_blockheader(boxedint32_header)
 let alloc_boxedint64_header = Cconst_blockheader(boxedint64_header)
@@ -635,7 +642,7 @@ let rec expr_size env = function
       RHS_floatblock (List.length args)
   | Uprim (Pduprecord ((Record_regular | Record_inlined _), sz), _, _) ->
       RHS_block sz
-  | Uprim (Pduprecord (Record_exception _, sz), _, _) ->
+  | Uprim (Pduprecord (Record_extension _, sz), _, _) ->
       RHS_block (sz + 1)
   | Uprim (Pduprecord (Record_float, sz), _, _) ->
       RHS_floatblock sz
@@ -1551,6 +1558,8 @@ and transl_prim_1 p arg dbg =
         Cop(Cload Double_u,
             [if n = 0 then ptr
                        else Cop(Cadda, [ptr; Cconst_int(n * size_float)])]))
+  | Pint_as_pointer ->
+     Cop(Cadda, [transl arg; Cconst_int (-1)])
   (* Exceptions *)
   | Praise k ->
       Cop(Craise (k, dbg), [transl arg])
@@ -2202,10 +2211,13 @@ let rec transl_all_functions already_translated cont =
 
 (* Emit structured constants *)
 
-let emit_block header symb cont =
-  Cint header :: Cdefine_symbol symb :: cont
-
 let rec emit_structured_constant symb cst cont =
+  let emit_block white_header symb cont =
+    (* Headers for structured constants must be marked black in case we
+       are in no-naked-pointers mode.  See [caml_darken]. *)
+    let black_header = Nativeint.logor white_header caml_black in
+    Cint black_header :: Cdefine_symbol symb :: cont
+  in
   match cst with
   | Uconst_float s->
       emit_block float_header symb (Cdouble s :: cont)
@@ -2282,7 +2294,7 @@ let emit_constant_closure symb fundecls cont =
             Cint(Nativeint.of_int (f2.arity lsl 1 + 1)) ::
             Csymbol_address f2.label ::
             emit_others (pos + 4) rem in
-      Cint(closure_header (fundecls_size fundecls)) ::
+      Cint(black_closure_header (fundecls_size fundecls)) ::
       Cdefine_symbol symb ::
       if f1.arity = 1 then
         Csymbol_address f1.label ::
@@ -2324,10 +2336,18 @@ let compunit size ulam =
                        fun_dbg  = Debuginfo.none }] in
   let c2 = transl_all_functions StringSet.empty c1 in
   let c3 = emit_all_constants c2 in
-  Cdata [Cint(block_header 0 size);
+  let space =
+    (* These words will be registered as roots and as such must contain
+       valid values, in case we are in no-naked-pointers mode.  Likewise
+       the block header must be black, below (see [caml_darken]), since
+       the overall record may be referenced. *)
+    Array.to_list
+      (Array.init size (fun _index ->
+        Cint (Nativeint.of_int 1 (* Val_unit *))))
+  in
+  Cdata ([Cint(black_block_header 0 size);
          Cglobal_symbol glob;
-         Cdefine_symbol glob;
-         Cskip(size * size_addr)] :: c3
+         Cdefine_symbol glob] @ space) :: c3
 
 (*
 CAMLprim value caml_cache_public_method (value meths, value tag, value *cache)
diff --git a/asmcomp/cmx_format.mli b/asmcomp/cmx_format.mli
index c4e5579699..51aa044083 100644
--- a/asmcomp/cmx_format.mli
+++ b/asmcomp/cmx_format.mli
@@ -26,8 +26,9 @@ type unit_infos =
   { mutable ui_name: string;                    (* Name of unit implemented *)
     mutable ui_symbol: string;            (* Prefix for symbols *)
     mutable ui_defines: string list;      (* Unit and sub-units implemented *)
-    mutable ui_imports_cmi: (string * Digest.t) list; (* Interfaces imported *)
-    mutable ui_imports_cmx: (string * Digest.t) list; (* Infos imported *)
+    mutable ui_imports_cmi:
+              (string * Digest.t option) list; (* Interfaces imported *)
+    mutable ui_imports_cmx:(string * Digest.t option) list; (* Infos imported *)
     mutable ui_approx: Clambda.value_approximation; (* Approx of the structure*)
     mutable ui_curry_fun: int list;             (* Currying functions needed *)
     mutable ui_apply_fun: int list;             (* Apply functions needed *)
@@ -49,8 +50,8 @@ type library_infos =
 type dynunit = {
   dynu_name: string;
   dynu_crc: Digest.t;
-  dynu_imports_cmi: (string * Digest.t) list;
-  dynu_imports_cmx: (string * Digest.t) list;
+  dynu_imports_cmi: (string * Digest.t option) list;
+  dynu_imports_cmx: (string * Digest.t option) list;
   dynu_defines: string list;
 }
 
diff --git a/asmcomp/compilenv.ml b/asmcomp/compilenv.ml
index 49a846667d..a313b97202 100644
--- a/asmcomp/compilenv.ml
+++ b/asmcomp/compilenv.ml
@@ -30,9 +30,9 @@ let global_infos_table =
 module CstMap =
   Map.Make(struct
     type t = Clambda.ustructured_constant
-    let compare = Pervasives.compare
-        (* could use a better version, comparing on the
-           first arg of Uconst_ref *)
+    let compare = Clambda.compare_structured_constants
+    (* PR#6442: it is incorrect to use Pervasives.compare on values of type t
+       because it compares "0.0" and "-0.0" equal. *)
   end)
 
 type structured_constants =
@@ -118,7 +118,7 @@ let symbol_in_current_unit name =
 let read_unit_info filename =
   let ic = open_in_bin filename in
   try
-    let buffer = input_bytes ic (String.length cmx_magic_number) in
+    let buffer = really_input_string ic (String.length cmx_magic_number) in
     if buffer <> cmx_magic_number then begin
       close_in ic;
       raise(Error(Not_a_unit_info filename))
@@ -133,7 +133,7 @@ let read_unit_info filename =
 
 let read_library_info filename =
   let ic = open_in_bin filename in
-  let buffer = input_bytes ic (String.length cmxa_magic_number) in
+  let buffer = really_input_string ic (String.length cmxa_magic_number) in
   if buffer <> cmxa_magic_number then
     raise(Error(Not_a_unit_info filename));
   let infos = (input_value ic : library_infos) in
@@ -143,9 +143,6 @@ let read_library_info filename =
 
 (* Read and cache info on global identifiers *)
 
-let cmx_not_found_crc =
-  "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000"
-
 let get_global_info global_ident = (
   let modname = Ident.name global_ident in
   if modname = current_unit.ui_name then
@@ -161,9 +158,9 @@ let get_global_info global_ident = (
           let (ui, crc) = read_unit_info filename in
           if ui.ui_name <> modname then
             raise(Error(Illegal_renaming(modname, ui.ui_name, filename)));
-          (Some ui, crc)
+          (Some ui, Some crc)
         with Not_found ->
-          (None, cmx_not_found_crc) in
+          (None, None) in
       current_unit.ui_imports_cmx <-
         (modname, crc) :: current_unit.ui_imports_cmx;
       Hashtbl.add global_infos_table modname infos;
@@ -231,7 +228,7 @@ let write_unit_info info filename =
   close_out oc
 
 let save_unit_info filename =
-  current_unit.ui_imports_cmi <- Env.imported_units();
+  current_unit.ui_imports_cmi <- Env.imports();
   write_unit_info current_unit filename
 
 
diff --git a/asmcomp/compilenv.mli b/asmcomp/compilenv.mli
index b705f4496d..7fae3bade6 100644
--- a/asmcomp/compilenv.mli
+++ b/asmcomp/compilenv.mli
@@ -79,10 +79,6 @@ val cache_unit_info: unit_infos -> unit
            honored by [symbol_for_global] and [global_approx]
            without looking at the corresponding .cmx file. *)
 
-val cmx_not_found_crc: Digest.t
-        (* Special digest used in the [ui_imports_cmx] list to signal
-           that no [.cmx] file was found and used for the imported unit *)
-
 val read_library_info: string -> library_infos
 
 type error =
diff --git a/asmcomp/deadcode.ml b/asmcomp/deadcode.ml
new file mode 100644
index 0000000000..cb93c2869d
--- /dev/null
+++ b/asmcomp/deadcode.ml
@@ -0,0 +1,67 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Gallium, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 2014 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.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* Dead code elimination: remove pure instructions whose results are
+   not used. *)
+
+open Mach
+
+(* [deadcode i] returns a pair of an optimized instruction [i']
+   and a set of registers live "before" instruction [i]. *)
+
+let rec deadcode i =
+  match i.desc with
+  | Iend | Ireturn | Iop(Itailcall_ind) | Iop(Itailcall_imm _) | Iraise _ ->
+      (i, Reg.add_set_array i.live i.arg)
+  | Iop op ->
+      let (s, before) = deadcode i.next in
+      if Proc.op_is_pure op                     (* no side effects *)
+      && Reg.disjoint_set_array before i.res    (* results are not used after *)
+      && not (Proc.regs_are_volatile i.arg)    (* no stack-like hard reg *)
+      && not (Proc.regs_are_volatile i.res)    (*            is involved *)
+      then begin
+        assert (Array.length i.res > 0);  (* sanity check *)
+        (s, before)
+      end else begin
+        ({i with next = s}, Reg.add_set_array i.live i.arg)
+      end
+  | Iifthenelse(test, ifso, ifnot) ->
+      let (ifso', _) = deadcode ifso in
+      let (ifnot', _) = deadcode ifnot in
+      let (s, _) = deadcode i.next in
+      ({i with desc = Iifthenelse(test, ifso', ifnot'); next = s},
+       Reg.add_set_array i.live i.arg)
+  | Iswitch(index, cases) ->
+      let cases' = Array.map (fun c -> fst (deadcode c)) cases in
+      let (s, _) = deadcode i.next in
+      ({i with desc = Iswitch(index, cases'); next = s},
+       Reg.add_set_array i.live i.arg)
+  | Iloop(body) ->
+      let (body', _) = deadcode body in
+      let (s, _) = deadcode i.next in
+      ({i with desc = Iloop body'; next = s}, i.live)
+  | Icatch(nfail, body, handler) ->
+      let (body', _) = deadcode body in
+      let (handler', _) = deadcode handler in
+      let (s, _) = deadcode i.next in
+      ({i with desc = Icatch(nfail, body', handler'); next = s}, i.live)
+  | Iexit nfail ->
+      (i, i.live)
+  | Itrywith(body, handler) ->
+      let (body', _) = deadcode body in
+      let (handler', _) = deadcode handler in
+      let (s, _) = deadcode i.next in
+      ({i with desc = Itrywith(body', handler'); next = s}, i.live)
+
+let fundecl f =
+  let (new_body, _) = deadcode f.fun_body in
+  {f with fun_body = new_body}
diff --git a/asmcomp/deadcode.mli b/asmcomp/deadcode.mli
new file mode 100644
index 0000000000..6aafae0540
--- /dev/null
+++ b/asmcomp/deadcode.mli
@@ -0,0 +1,16 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Gallium, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 2014 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.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* Dead code elimination: remove pure instructions whose results are
+   not used. *)
+
+val fundecl: Mach.fundecl -> Mach.fundecl
diff --git a/asmcomp/emitaux.ml b/asmcomp/emitaux.ml
index ccfa977ffa..24a621b339 100644
--- a/asmcomp/emitaux.ml
+++ b/asmcomp/emitaux.ml
@@ -88,16 +88,10 @@ let emit_bytes_directive directive s =
    done;
    if !pos > 0 then emit_char '\n'
 
-(* PR#4813: assemblers do strange things with float literals indeed,
-   so we convert to IEEE representation ourselves and emit float
-   literals as 32- or 64-bit integers. *)
-
-let emit_float64_directive directive f =
-  let x = Int64.bits_of_float (float_of_string f) in
+let emit_float64_directive directive x =
   emit_printf "\t%s\t0x%Lx\n" directive x
 
-let emit_float64_split_directive directive f =
-  let x = Int64.bits_of_float (float_of_string f) in
+let emit_float64_split_directive directive x =
   let lo = Int64.logand x 0xFFFF_FFFFL
   and hi = Int64.shift_right_logical x 32 in
   emit_printf "\t%s\t0x%Lx, 0x%Lx\n"
@@ -105,8 +99,7 @@ let emit_float64_split_directive directive f =
     (if Arch.big_endian then hi else lo)
     (if Arch.big_endian then lo else hi)
 
-let emit_float32_directive directive f =
-  let x = Int32.bits_of_float (float_of_string f) in
+let emit_float32_directive directive x =
   emit_printf "\t%s\t0x%lx\n" directive x
 
 (* Record live pointers at call points *)
@@ -239,3 +232,7 @@ let emit_debug_info dbg =
     emit_int file_num; emit_char '\t';
     emit_int line; emit_char '\n'
   end
+
+let reset () =
+  reset_debug_info ();
+  frame_descriptors := []
diff --git a/asmcomp/emitaux.mli b/asmcomp/emitaux.mli
index cc479d8ccf..486a5839ce 100644
--- a/asmcomp/emitaux.mli
+++ b/asmcomp/emitaux.mli
@@ -23,10 +23,11 @@ val emit_char: char -> unit
 val emit_string_literal: string -> unit
 val emit_string_directive: string -> string -> unit
 val emit_bytes_directive: string -> string -> unit
-val emit_float64_directive: string -> string -> unit
-val emit_float64_split_directive: string -> string -> unit
-val emit_float32_directive: string -> string -> unit
+val emit_float64_directive: string -> int64 -> unit
+val emit_float64_split_directive: string -> int64 -> unit
+val emit_float32_directive: string -> int32 -> unit
 
+val reset : unit -> unit
 val reset_debug_info: unit -> unit
 val emit_debug_info: Debuginfo.t -> unit
 
diff --git a/asmcomp/i386/CSE.ml b/asmcomp/i386/CSE.ml
new file mode 100644
index 0000000000..3ce4567024
--- /dev/null
+++ b/asmcomp/i386/CSE.ml
@@ -0,0 +1,48 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Gallium, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 2014 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.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* CSE for the i386 *)
+
+open Cmm
+open Arch
+open Mach
+open CSEgen
+
+class cse = object (self)
+
+inherit cse_generic as super
+
+method! class_of_operation op =
+  match op with
+  (* Operations that affect the floating-point stack cannot be factored *)
+  | Iconst_float _ | Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf
+  | Iintoffloat | Ifloatofint
+  | Iload((Single | Double | Double_u), _) -> Op_other
+  (* Specific ops *)
+  | Ispecific(Ilea _) -> Op_pure
+  | Ispecific(Istore_int(_, _, is_asg)) -> Op_store is_asg
+  | Ispecific(Istore_symbol(_, _, is_asg)) -> Op_store is_asg
+  | Ispecific(Ioffset_loc(_, _)) -> Op_store true
+  | Ispecific _ -> Op_other
+  | _ -> super#class_of_operation op
+
+method! is_cheap_operation op =
+  match op with
+  | Iconst_int _ | Iconst_blockheader _ -> true
+  | Iconst_symbol _ -> true
+  | _ -> false
+
+end
+
+let fundecl f =
+  (new cse)#fundecl f
+
diff --git a/asmcomp/i386/arch.ml b/asmcomp/i386/arch.ml
index d2f9fd61a8..25e6edb68d 100644
--- a/asmcomp/i386/arch.ml
+++ b/asmcomp/i386/arch.ml
@@ -31,8 +31,8 @@ type addressing_mode =
 
 type specific_operation =
     Ilea of addressing_mode             (* Lea gives scaled adds *)
-  | Istore_int of nativeint * addressing_mode (* Store an integer constant *)
-  | Istore_symbol of string * addressing_mode (* Store a symbol *)
+  | Istore_int of nativeint * addressing_mode * bool (* Store an integer constant *)
+  | Istore_symbol of string * addressing_mode * bool (* Store a symbol *)
   | Ioffset_loc of int * addressing_mode (* Add a constant to a location *)
   | Ipush                               (* Push regs on stack *)
   | Ipush_int of nativeint            (* Push an integer constant *)
@@ -105,11 +105,14 @@ let print_addressing printreg addr ppf arg =
 let print_specific_operation printreg op ppf arg =
   match op with
   | Ilea addr -> print_addressing printreg addr ppf arg
-  | Istore_int(n, addr) ->
-      fprintf ppf "[%a] := %s" (print_addressing printreg addr) arg
-                               (Nativeint.to_string n)
-  | Istore_symbol(lbl, addr) ->
-      fprintf ppf "[%a] := \"%s\"" (print_addressing printreg addr) arg lbl
+  | Istore_int(n, addr, is_assign) ->
+      fprintf ppf "[%a] := %nd %s"
+         (print_addressing printreg addr) arg n
+         (if is_assign then "(assign)" else "(init)")
+  | Istore_symbol(lbl, addr, is_assign) ->
+      fprintf ppf "[%a] := \"%s\" %s"
+         (print_addressing printreg addr) arg lbl
+         (if is_assign then "(assign)" else "(init)")
   | Ioffset_loc(n, addr) ->
       fprintf ppf "[%a] +:= %i" (print_addressing printreg addr) arg n
   | Ipush ->
@@ -152,5 +155,7 @@ let print_specific_operation printreg op ppf arg =
 
 let stack_alignment =
   match Config.system with
-  | "macosx" -> 16
-  | _ -> 4
+  | "win32" -> 4     (* MSVC *)
+  | _ -> 16
+(* PR#6038: GCC and Clang seem to require 16-byte alignment nowadays,
+   even if only MacOS X's ABI formally requires it *)
diff --git a/asmcomp/i386/emit.mlp b/asmcomp/i386/emit.mlp
index 2b90d37f64..98df5f958b 100644
--- a/asmcomp/i386/emit.mlp
+++ b/asmcomp/i386/emit.mlp
@@ -412,15 +412,16 @@ let emit_floatspecial = function
 
 (* Floating-point constants *)
 
-let float_constants = ref ([] : (string * int) list)
+let float_constants = ref ([] : (int64 * int) list)
 
 let add_float_constant cst =
+  let repr = Int64.bits_of_float cst in
   try
-    List.assoc cst !float_constants
+    List.assoc repr !float_constants
   with
     Not_found ->
       let lbl = new_label() in
-      float_constants := (cst, lbl) :: !float_constants;
+      float_constants := (repr, lbl) :: !float_constants;
       lbl
 
 let emit_float_constant (cst, lbl) =
@@ -465,8 +466,8 @@ let emit_instr fallthrough i =
           | _     -> `	movl	$0, {emit_reg i.res.(0)}\n`
         end else
           `	movl	${emit_nativeint n}, {emit_reg i.res.(0)}\n`
-    | Lop(Iconst_float s) ->
-        begin match Int64.bits_of_float (float_of_string s) with
+    | Lop(Iconst_float f) ->
+        begin match Int64.bits_of_float f with
         | 0x0000_0000_0000_0000L ->       (* +0.0 *)
           `	fldz\n`
         | 0x8000_0000_0000_0000L ->       (* -0.0 *)
@@ -476,7 +477,7 @@ let emit_instr fallthrough i =
         | 0xBFF0_0000_0000_0000L ->       (* -1.0 *)
           `	fld1\n	fchs\n`
         | _ ->
-          let lbl = add_float_constant s in
+          let lbl = add_float_constant f in
           `	fldl	{emit_label lbl}\n`
         end
     | Lop(Iconst_symbol s) ->
@@ -543,7 +544,7 @@ let emit_instr fallthrough i =
           | Double | Double_u ->
             `	fldl	{emit_addressing addr i.arg 0}\n`
         end
-    | Lop(Istore(chunk, addr)) ->
+    | Lop(Istore(chunk, addr, _)) ->
         begin match chunk with
           | Word | Thirtytwo_signed | Thirtytwo_unsigned ->
             `	movl	{emit_reg i.arg.(0)}, {emit_addressing addr i.arg 1}\n`
@@ -683,9 +684,9 @@ let emit_instr fallthrough i =
         stack_offset := !stack_offset + 8
     | Lop(Ispecific(Ilea addr)) ->
         `	lea	{emit_addressing addr i.arg 0}, {emit_reg i.res.(0)}\n`
-    | Lop(Ispecific(Istore_int(n, addr))) ->
+    | Lop(Ispecific(Istore_int(n, addr, _))) ->
         `	movl	${emit_nativeint n}, {emit_addressing addr i.arg 0}\n`
-    | Lop(Ispecific(Istore_symbol(s, addr))) ->
+    | Lop(Ispecific(Istore_symbol(s, addr, _))) ->
         `	movl	${emit_symbol s}, {emit_addressing addr i.arg 0}\n`
     | Lop(Ispecific(Ioffset_loc(n, addr))) ->
         `	addl	${emit_int n}, {emit_addressing addr i.arg 0}\n`
@@ -960,9 +961,9 @@ let emit_item = function
   | Cint n ->
       `	.long	{emit_nativeint n}\n`
   | Csingle f ->
-      emit_float32_directive ".long" f
+      emit_float32_directive ".long" (Int32.bits_of_float f)
   | Cdouble f ->
-      emit_float64_split_directive ".long" f
+      emit_float64_split_directive ".long" (Int64.bits_of_float f)
   | Csymbol_address s ->
       `	.long	{emit_symbol s}\n`
   | Clabel_address lbl ->
diff --git a/asmcomp/i386/emit_nt.mlp b/asmcomp/i386/emit_nt.mlp
index 495a29aecc..ef5205ef8f 100644
--- a/asmcomp/i386/emit_nt.mlp
+++ b/asmcomp/i386/emit_nt.mlp
@@ -62,7 +62,10 @@ let add_used_symbol s =
 let emit_symbol s =
   emit_string "_"; Emitaux.emit_symbol '$' s
 
+(* Output a 32 or 64 bit integer in hex *)
+
 let emit_int32 n = emit_printf "0%lxh" n
+let emit_int64 n = emit_printf "0%Lxh" n
 
 (* Output a label *)
 
@@ -361,36 +364,20 @@ let emit_floatspecial = function
 
 (* Floating-point constants *)
 
-let float_constants = ref ([] : (string * int) list)
+let float_constants = ref ([] : (int64 * int) list)
 
 let add_float_constant cst =
+  let repr = Int64.bits_of_float cst in
   try
-    List.assoc cst !float_constants
+    List.assoc repr !float_constants
   with
     Not_found ->
       let lbl = new_label() in
-      float_constants := (cst, lbl) :: !float_constants;
+      float_constants := (repr, lbl) :: !float_constants;
       lbl
 
-let emit_float s =
-  (* MASM doesn't like floating-point constants such as 2e9.
-     Turn them into 2.0e9. *)
-  let pos_e = ref (-1) and pos_dot = ref (-1) in
-  for i = 0 to String.length s - 1 do
-    match s.[i] with
-      'e'|'E' -> pos_e := i
-    | '.'     -> pos_dot := i
-    | _       -> ()
-  done;
-  if !pos_dot < 0 && !pos_e >= 0 then begin
-    emit_string (String.sub s 0 !pos_e);
-    emit_string ".0";
-    emit_string (String.sub s !pos_e (String.length s - !pos_e))
-  end else
-    emit_string s
-
 let emit_float_constant (cst, lbl) =
-  `{emit_label lbl}     REAL8   {emit_float cst}\n`
+  `{emit_label lbl}	QWORD	{emit_int64 cst}\n`
 
 (* Output the assembly code for an instruction *)
 
@@ -426,8 +413,8 @@ let emit_instr i =
           | _     -> `	mov	{emit_reg i.res.(0)}, 0\n`
         end else
           `	mov	{emit_reg i.res.(0)}, {emit_nativeint n}\n`
-    | Lop(Iconst_float s) ->
-        begin match Int64.bits_of_float (float_of_string s) with
+    | Lop(Iconst_float f) ->
+        begin match Int64.bits_of_float f with
         | 0x0000_0000_0000_0000L ->       (* +0.0 *)
           `	fldz\n`
         | 0x8000_0000_0000_0000L ->       (* -0.0 *)
@@ -437,7 +424,7 @@ let emit_instr i =
         | 0xBFF0_0000_0000_0000L ->       (* -1.0 *)
           `	fld1\n	fchs\n`
         | _ ->
-          let lbl = add_float_constant s in
+          let lbl = add_float_constant f in
           `	fld	{emit_label lbl}\n`
         end
     | Lop(Iconst_symbol s) ->
@@ -493,7 +480,7 @@ let emit_instr i =
           | Double | Double_u ->
             `	fld	REAL8 PTR {emit_addressing addr i.arg 0}\n`
         end
-    | Lop(Istore(chunk, addr)) ->
+    | Lop(Istore(chunk, addr, _)) ->
         begin match chunk with
           | Word | Thirtytwo_signed | Thirtytwo_unsigned ->
             `	mov	DWORD PTR {emit_addressing addr i.arg 1}, {emit_reg i.arg.(0)}\n`
@@ -631,9 +618,9 @@ let emit_instr i =
         stack_offset := !stack_offset + 8
     | Lop(Ispecific(Ilea addr)) ->
         `	lea	{emit_reg i.res.(0)}, DWORD PTR {emit_addressing addr i.arg 0}\n`
-    | Lop(Ispecific(Istore_int(n, addr))) ->
+    | Lop(Ispecific(Istore_int(n, addr, _))) ->
         `	mov	DWORD PTR {emit_addressing addr i.arg 0},{emit_nativeint n}\n`
-    | Lop(Ispecific(Istore_symbol(s, addr))) ->
+    | Lop(Ispecific(Istore_symbol(s, addr, _))) ->
         add_used_symbol s ;
         `	mov	DWORD PTR {emit_addressing addr i.arg 0},OFFSET {emit_symbol s}\n`
     | Lop(Ispecific(Ioffset_loc(n, addr))) ->
@@ -816,9 +803,9 @@ let emit_item = function
   | Cint32 n ->
       `	DWORD	{emit_nativeint n}\n`
   | Csingle f ->
-      `	REAL4	{emit_float f}\n`
+      `	DWORD	{emit_int32 (Int32.bits_of_float f)}\n`
   | Cdouble f ->
-      `	REAL8	{emit_float f}\n`
+      `	QWORD	{emit_int64 (Int64.bits_of_float f)}\n`
   | Csymbol_address s ->
       add_used_symbol s ;
       `	DWORD	{emit_symbol s}\n`
diff --git a/asmcomp/i386/proc.ml b/asmcomp/i386/proc.ml
index d80d182088..8bbd42c158 100644
--- a/asmcomp/i386/proc.ml
+++ b/asmcomp/i386/proc.ml
@@ -154,6 +154,21 @@ let loc_external_results res =
 
 let loc_exn_bucket = eax
 
+(* Volatile registers: the x87 top of FP stack is *)
+
+let reg_is_volatile = function
+  | { typ = Float; loc = Reg _ } -> true
+  | _ -> false
+
+let regs_are_volatile rs =
+  try
+    for i = 0 to Array.length rs - 1 do
+      if reg_is_volatile rs.(i) then raise Exit
+    done;
+    false
+  with Exit ->
+    true
+
 (* Registers destroyed by operations *)
 
 let destroyed_at_c_call =               (* ebx, esi, edi, ebp preserved *)
@@ -182,6 +197,17 @@ let max_register_pressure = function
     Iintoffloat -> [| 6; max_int |]
   | _ -> [|7; max_int |]
 
+(* Pure operations (without any side effect besides updating their result
+   registers).  *)
+
+let op_is_pure = function
+  | Icall_ind | Icall_imm _ | Itailcall_ind | Itailcall_imm _
+  | Iextcall _ | Istackoffset _ | Istore _ | Ialloc _
+  | Iintop(Icheckbound) | Iintop_imm(Icheckbound, _) -> false
+  | Ispecific(Ilea _) -> true
+  | Ispecific _ -> false
+  | _ -> true
+
 (* Layout of the stack frame *)
 
 let num_stack_slots = [| 0; 0 |]
diff --git a/asmcomp/i386/selection.ml b/asmcomp/i386/selection.ml
index d86f1b2823..10d2d40e37 100644
--- a/asmcomp/i386/selection.ml
+++ b/asmcomp/i386/selection.ml
@@ -135,7 +135,7 @@ let pseudoregs_for_operation op arg res =
   (* For storing a byte, the argument must be in eax...edx.
      (But for a short, any reg will do!)
      Keep it simple, just force the argument to be in edx. *)
-  | Istore((Byte_unsigned | Byte_signed), addr) ->
+  | Istore((Byte_unsigned | Byte_signed), addr, _) ->
       let newarg = Array.copy arg in
       newarg.(0) <- edx;
       (newarg, res, false)
@@ -178,20 +178,20 @@ method select_addressing chunk exp =
   | (Ascaledadd(e1, e2, scale), d) ->
       (Iindexed2scaled(scale, d), Ctuple[e1; e2])
 
-method! select_store addr exp =
+method! select_store is_assign addr exp =
   match exp with
     Cconst_int n ->
-      (Ispecific(Istore_int(Nativeint.of_int n, addr)), Ctuple [])
+      (Ispecific(Istore_int(Nativeint.of_int n, addr, is_assign)), Ctuple [])
   | (Cconst_natint n | Cconst_blockheader n) ->
-      (Ispecific(Istore_int(n, addr)), Ctuple [])
+      (Ispecific(Istore_int(n, addr, is_assign)), Ctuple [])
   | Cconst_pointer n ->
-      (Ispecific(Istore_int(Nativeint.of_int n, addr)), Ctuple [])
+      (Ispecific(Istore_int(Nativeint.of_int n, addr, is_assign)), Ctuple [])
   | Cconst_natpointer n ->
-      (Ispecific(Istore_int(n, addr)), Ctuple [])
+      (Ispecific(Istore_int(n, addr, is_assign)), Ctuple [])
   | Cconst_symbol s ->
-      (Ispecific(Istore_symbol(s, addr)), Ctuple [])
+      (Ispecific(Istore_symbol(s, addr, is_assign)), Ctuple [])
   | _ ->
-      super#select_store addr exp
+      super#select_store is_assign addr exp
 
 method! select_operation op args =
   match op with
diff --git a/asmcomp/linearize.ml b/asmcomp/linearize.ml
index ebe590c56c..48dde690c4 100644
--- a/asmcomp/linearize.ml
+++ b/asmcomp/linearize.ml
@@ -126,9 +126,9 @@ let rec discard_dead_code n =
   match n.desc with
     Lend -> n
   | Llabel _ -> n
-(* Do not discard Lpoptrap or Istackoffset instructions,
+(* Do not discard Lpoptrap/Lpushtrap or Istackoffset instructions,
    as this may cause a stack imbalance later during assembler generation. *)
-  | Lpoptrap -> n
+  | Lpoptrap | Lpushtrap -> n
   | Lop(Istackoffset _) -> n
   | _ -> discard_dead_code n.next
 
@@ -148,20 +148,30 @@ let add_branch lbl n =
   else
     discard_dead_code n
 
-(* Current labels for exit handler *)
+let try_depth = ref 0
+
+(* Association list: exit handler -> (handler label, try-nesting factor) *)
 
 let exit_label = ref []
 
-let find_exit_label k =
+let find_exit_label_try_depth k =
   try
     List.assoc k !exit_label
   with
   | Not_found -> Misc.fatal_error "Linearize.find_exit_label"
 
+let find_exit_label k =
+  let (label, t) = find_exit_label_try_depth k in
+  assert(t = !try_depth);
+  label
+
 let is_next_catch n = match !exit_label with
-| (n0,_)::_  when n0=n -> true
+| (n0,(_,t))::_  when n0=n && t = !try_depth -> true
 | _ -> false
 
+let local_exit k =
+  snd (find_exit_label_try_depth k) = !try_depth
+
 (* Linearize an instruction [i]: add it in front of the continuation [n] *)
 
 let rec linear i n =
@@ -187,15 +197,15 @@ let rec linear i n =
       | _, Iend, Lbranch lbl ->
           copy_instr (Lcondbranch(invert_test test, lbl)) i (linear ifso n1)
       | Iexit nfail1, Iexit nfail2, _
-            when is_next_catch nfail1 ->
+            when is_next_catch nfail1 && local_exit nfail2 ->
           let lbl2 = find_exit_label nfail2 in
           copy_instr
             (Lcondbranch (invert_test test, lbl2)) i (linear ifso n1)
-      | Iexit nfail, _, _ ->
+      | Iexit nfail, _, _ when local_exit nfail ->
           let n2 = linear ifnot n1
           and lbl = find_exit_label nfail in
           copy_instr (Lcondbranch(test, lbl)) i n2
-      | _,  Iexit nfail, _ ->
+      | _,  Iexit nfail, _ when local_exit nfail ->
           let n2 = linear ifso n1 in
           let lbl = find_exit_label nfail in
           copy_instr (Lcondbranch(invert_test test, lbl)) i n2
@@ -242,24 +252,44 @@ let rec linear i n =
   | Icatch(io, body, handler) ->
       let (lbl_end, n1) = get_label(linear i.Mach.next n) in
       let (lbl_handler, n2) = get_label(linear handler n1) in
-      exit_label := (io, lbl_handler) :: !exit_label ;
+      exit_label := (io, (lbl_handler, !try_depth)) :: !exit_label ;
       let n3 = linear body (add_branch lbl_end n2) in
       exit_label := List.tl !exit_label;
       n3
   | Iexit nfail ->
-      let n1 = linear i.Mach.next n in
-      let lbl = find_exit_label nfail in
-      add_branch lbl n1
+      let lbl, t = find_exit_label_try_depth nfail in
+      (* We need to re-insert dummy pushtrap (which won't be executed),
+         so as to preserve stack offset during assembler generation.
+         It would make sense to have a special pseudo-instruction
+         only to inform the later pass about this stack offset
+         (corresponding to N traps).
+       *)
+      let rec loop i tt =
+        if t = tt then i
+        else loop (cons_instr Lpushtrap i) (tt - 1)
+      in
+      let n1 = loop (linear i.Mach.next n) !try_depth in
+      let rec loop i tt =
+        if t = tt then i
+        else loop (cons_instr Lpoptrap i) (tt - 1)
+      in
+      loop (add_branch lbl n1) !try_depth
   | Itrywith(body, handler) ->
       let (lbl_join, n1) = get_label (linear i.Mach.next n) in
+      incr try_depth;
       let (lbl_body, n2) =
         get_label (cons_instr Lpushtrap
                     (linear body (cons_instr Lpoptrap n1))) in
+      decr try_depth;
       cons_instr (Lsetuptrap lbl_body)
         (linear handler (add_branch lbl_join n2))
   | Iraise k ->
       copy_instr (Lraise k) i (discard_dead_code n)
 
+let reset () =
+  label_counter := 99;
+  exit_label := []
+
 let fundecl f =
   { fun_name = f.Mach.fun_name;
     fun_body = linear f.Mach.fun_body end_instr;
diff --git a/asmcomp/linearize.mli b/asmcomp/linearize.mli
index 22987e5ba1..2996a29bf2 100644
--- a/asmcomp/linearize.mli
+++ b/asmcomp/linearize.mli
@@ -50,4 +50,5 @@ type fundecl =
     fun_fast: bool;
     fun_dbg : Debuginfo.t }
 
+val reset : unit -> unit
 val fundecl: Mach.fundecl -> fundecl
diff --git a/asmcomp/liveness.ml b/asmcomp/liveness.ml
index 434d506558..2ef322ef3e 100644
--- a/asmcomp/liveness.ml
+++ b/asmcomp/liveness.ml
@@ -16,13 +16,13 @@
 open Mach
 
 let live_at_exit = ref []
+
 let find_live_at_exit k =
   try
     List.assoc k !live_at_exit
   with
-  | Not_found -> Misc.fatal_error "Spill.find_live_at_exit"
+  | Not_found -> Misc.fatal_error "Liveness.find_live_at_exit"
 
-let live_at_break = ref Reg.Set.empty
 let live_at_raise = ref Reg.Set.empty
 
 let rec live i finally =
@@ -37,8 +37,34 @@ let rec live i finally =
       i.live <- finally;
       finally
   | Ireturn | Iop(Itailcall_ind) | Iop(Itailcall_imm _) ->
-      (* i.live remains empty since no regs are live across *)
+      i.live <- Reg.Set.empty; (* no regs are live across *)
       Reg.set_of_array i.arg
+  | Iop op ->
+      let after = live i.next finally in
+      if Proc.op_is_pure op                    (* no side effects *)
+      && Reg.disjoint_set_array after i.res    (* results are not used after *)
+      && not (Proc.regs_are_volatile i.arg)    (* no stack-like hard reg *)
+      && not (Proc.regs_are_volatile i.res)    (*            is involved *)
+      then begin
+        (* This operation is dead code.  Ignore its arguments. *)
+        i.live <- after;
+        after
+      end else begin
+        let across_after = Reg.diff_set_array after i.res in
+        let across =
+          match op with
+          | Icall_ind | Icall_imm _ | Iextcall _
+          | Iintop Icheckbound | Iintop_imm(Icheckbound, _) ->
+              (* The function call may raise an exception, branching to the
+                 nearest enclosing try ... with. Similarly for bounds checks.
+                 Hence, everything that must be live at the beginning of
+                 the exception handler must also be live across this instr. *)
+               Reg.Set.union across_after !live_at_raise
+           | _ ->
+               across_after in
+        i.live <- across;
+        Reg.add_set_array across i.arg
+      end
   | Iifthenelse(test, ifso, ifnot) ->
       let at_join = live i.next finally in
       let at_fork = Reg.Set.union (live ifso at_join) (live ifnot at_join) in
@@ -90,23 +116,12 @@ let rec live i finally =
       i.live <- before_body;
       before_body
   | Iraise _ ->
-      (* i.live remains empty since no regs are live across *)
+      i.live <- !live_at_raise;
       Reg.add_set_array !live_at_raise i.arg
-  | _ ->
-      let across_after = Reg.diff_set_array (live i.next finally) i.res in
-      let across =
-        match i.desc with
-          Iop Icall_ind | Iop(Icall_imm _) | Iop(Iextcall _)
-        | Iop(Iintop Icheckbound) | Iop(Iintop_imm(Icheckbound, _)) ->
-            (* The function call may raise an exception, branching to the
-               nearest enclosing try ... with. Similarly for bounds checks.
-               Hence, everything that must be live at the beginning of
-               the exception handler must also be live across this instr. *)
-             Reg.Set.union across_after !live_at_raise
-         | _ ->
-             across_after in
-      i.live <- across;
-      Reg.add_set_array across i.arg
+
+let reset () =
+  live_at_raise := Reg.Set.empty;
+  live_at_exit := []
 
 let fundecl ppf f =
   let initially_live = live f.fun_body Reg.Set.empty in
diff --git a/asmcomp/liveness.mli b/asmcomp/liveness.mli
index b52ec5a2b8..ed2f1a8aeb 100644
--- a/asmcomp/liveness.mli
+++ b/asmcomp/liveness.mli
@@ -15,4 +15,5 @@
 
 open Format
 
+val reset : unit -> unit
 val fundecl: formatter -> Mach.fundecl -> unit
diff --git a/asmcomp/mach.ml b/asmcomp/mach.ml
index a11910ec73..3a7174763a 100644
--- a/asmcomp/mach.ml
+++ b/asmcomp/mach.ml
@@ -36,7 +36,7 @@ type operation =
   | Ispill
   | Ireload
   | Iconst_int of nativeint
-  | Iconst_float of string
+  | Iconst_float of float
   | Iconst_symbol of string
   | Iconst_blockheader of nativeint
   | Icall_ind
@@ -46,7 +46,7 @@ type operation =
   | Iextcall of string * bool
   | Istackoffset of int
   | Iload of Cmm.memory_chunk * Arch.addressing_mode
-  | Istore of Cmm.memory_chunk * Arch.addressing_mode
+  | Istore of Cmm.memory_chunk * Arch.addressing_mode * bool
   | Ialloc of int
   | Iintop of integer_operation
   | Iintop_imm of integer_operation * int
diff --git a/asmcomp/mach.mli b/asmcomp/mach.mli
index 000c3cf9f1..618e5e4ce7 100644
--- a/asmcomp/mach.mli
+++ b/asmcomp/mach.mli
@@ -36,17 +36,18 @@ type operation =
   | Ispill
   | Ireload
   | Iconst_int of nativeint
-  | Iconst_float of string
+  | Iconst_float of float
   | Iconst_symbol of string
   | Iconst_blockheader of nativeint
   | Icall_ind
   | Icall_imm of string
   | Itailcall_ind
   | Itailcall_imm of string
-  | Iextcall of string * bool
+  | Iextcall of string * bool    (* false = noalloc, true = alloc *)
   | Istackoffset of int
   | Iload of Cmm.memory_chunk * Arch.addressing_mode
-  | Istore of Cmm.memory_chunk * Arch.addressing_mode
+  | Istore of Cmm.memory_chunk * Arch.addressing_mode * bool
+                                 (* false = initialization, true = assignment *)
   | Ialloc of int
   | Iintop of integer_operation
   | Iintop_imm of integer_operation * int
diff --git a/asmcomp/power/CSE.ml b/asmcomp/power/CSE.ml
new file mode 100644
index 0000000000..50fefa5e35
--- /dev/null
+++ b/asmcomp/power/CSE.ml
@@ -0,0 +1,38 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Gallium, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 2014 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.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* CSE for the PowerPC *)
+
+open Arch
+open Mach
+open CSEgen
+
+class cse = object (self)
+
+inherit cse_generic as super
+
+method! class_of_operation op =
+  match op with
+  | Ispecific(Imultaddf | Imultsubf) -> Op_pure
+  | Ispecific(Ialloc_far _) -> Op_other
+  | _ -> super#class_of_operation op
+
+method! is_cheap_operation op =
+  match op with
+  | Iconst_int n | Iconst_blockheader n -> n <= 32767n && n >= -32768n
+  | _ -> false
+
+end
+
+let fundecl f =
+  (new cse)#fundecl f
+
diff --git a/asmcomp/power/emit.mlp b/asmcomp/power/emit.mlp
index f6ee1a2321..0a26ed1479 100644
--- a/asmcomp/power/emit.mlp
+++ b/asmcomp/power/emit.mlp
@@ -229,7 +229,7 @@ let record_frame live dbg =
 
 (* Record floating-point and large integer literals *)
 
-let float_literals = ref ([] : (string * int) list)
+let float_literals = ref ([] : (int64 * int) list)
 let int_literals = ref ([] : (nativeint * int) list)
 
 (* Record external C functions to be called in a position-independent way
@@ -333,7 +333,7 @@ let instr_size = function
       if chunk = Byte_signed
       then load_store_size addr + 1
       else load_store_size addr
-  | Lop(Istore(chunk, addr)) -> load_store_size addr
+  | Lop(Istore(chunk, addr, _)) -> load_store_size addr
   | Lop(Ialloc n) -> 4
   | Lop(Ispecific(Ialloc_far n)) -> 5
   | Lop(Iintop Imod) -> 3
@@ -466,9 +466,9 @@ let rec emit_instr i dslot =
           `	addis	{emit_gpr 11}, 0, {emit_upper emit_label lbl}\n`;
           `	{emit_string lg}	{emit_reg i.res.(0)}, {emit_lower emit_label lbl}({emit_gpr 11})\n`
         end
-    | Lop(Iconst_float s) ->
+    | Lop(Iconst_float f) ->
         let lbl = new_label() in
-        float_literals := (s, lbl) :: !float_literals;
+        float_literals := (Int64.bits_of_float f, lbl) :: !float_literals;
         `	addis	{emit_gpr 11}, 0, {emit_upper emit_label lbl}\n`;
         `	lfd	{emit_reg i.res.(0)}, {emit_lower emit_label lbl}({emit_gpr 11})\n`
     | Lop(Iconst_symbol s) ->
@@ -548,7 +548,7 @@ let rec emit_instr i dslot =
         emit_load_store loadinstr addr i.arg 0 i.res.(0);
         if chunk = Byte_signed then
           `	extsb	{emit_reg i.res.(0)}, {emit_reg i.res.(0)}\n`
-    | Lop(Istore(chunk, addr)) ->
+    | Lop(Istore(chunk, addr, _)) ->
         let storeinstr =
           match chunk with
             Byte_unsigned | Byte_signed -> "stb"
@@ -628,8 +628,7 @@ let rec emit_instr i dslot =
           `	fcfid	{emit_reg i.res.(0)}, {emit_reg i.res.(0)}\n`
 	end else begin
           let lbl = new_label() in
-          float_literals := ("4.503601774854144e15", lbl) :: !float_literals;
-          (* That float above represents 0x4330000080000000 *)
+          float_literals := (0x4330000080000000L, lbl) :: !float_literals;
           `	addis	{emit_gpr 11}, 0, {emit_upper emit_label lbl}\n`;
           `	lfd	{emit_fpr 0}, {emit_lower emit_label lbl}({emit_gpr 11})\n`;
           `	lis	{emit_gpr 0}, 0x4330\n`;
@@ -899,11 +898,11 @@ let emit_item = function
   | Cint n ->
       `	{emit_string datag}	{emit_nativeint n}\n`
   | Csingle f ->
-      emit_float32_directive ".long" f
+      emit_float32_directive ".long" (Int32.bits_of_float f)
   | Cdouble f ->
       if ppc64
-      then emit_float64_directive ".quad" f
-      else emit_float64_split_directive ".long" f
+      then emit_float64_directive ".quad" (Int64.bits_of_float f)
+      else emit_float64_split_directive ".long" (Int64.bits_of_float f)
   | Csymbol_address s ->
       `	{emit_string datag}	{emit_symbol s}\n`
   | Clabel_address lbl ->
diff --git a/asmcomp/power/proc.ml b/asmcomp/power/proc.ml
index 203e8a9ef4..bafa8a4c5f 100644
--- a/asmcomp/power/proc.ml
+++ b/asmcomp/power/proc.ml
@@ -200,6 +200,10 @@ let loc_external_results res =
 
 let loc_exn_bucket = phys_reg 0
 
+(* Volatile registers: none *)
+
+let regs_are_volatile rs = false
+
 (* Registers destroyed by operations *)
 
 let destroyed_at_c_call =
@@ -224,6 +228,17 @@ let max_register_pressure = function
     Iextcall(_, _) -> [| 15; 18 |]
   | _ -> [| 23; 30 |]
 
+(* Pure operations (without any side effect besides updating their result
+   registers). *)
+
+let op_is_pure = function
+  | Icall_ind | Icall_imm _ | Itailcall_ind | Itailcall_imm _
+  | Iextcall _ | Istackoffset _ | Istore _ | Ialloc _
+  | Iintop(Icheckbound) | Iintop_imm(Icheckbound, _) -> false
+  | Ispecific(Imultaddf | Imultsubf) -> true
+  | Ispecific _ -> false
+  | _ -> true
+
 (* Layout of the stack *)
 
 let num_stack_slots = [| 0; 0 |]
diff --git a/asmcomp/power/scheduling.ml b/asmcomp/power/scheduling.ml
index 6e594f0283..7adaa2eed3 100644
--- a/asmcomp/power/scheduling.ml
+++ b/asmcomp/power/scheduling.ml
@@ -44,7 +44,7 @@ method reload_retaddr_latency = 12
 method oper_issue_cycles = function
     Iconst_float _ | Iconst_symbol _ -> 2
   | Iload(_, Ibased(_, _)) -> 2
-  | Istore(_, Ibased(_, _)) -> 2
+  | Istore(_, Ibased(_, _), _) -> 2
   | Ialloc _ -> 4
   | Iintop(Imod) -> 40 (* assuming full stall *)
   | Iintop(Icomp _) -> 4
diff --git a/asmcomp/printclambda.ml b/asmcomp/printclambda.ml
index f4e3b4d93f..b28d749e24 100644
--- a/asmcomp/printclambda.ml
+++ b/asmcomp/printclambda.ml
@@ -16,17 +16,20 @@ open Asttypes
 open Clambda
 
 let rec structured_constant ppf = function
-  | Uconst_float x -> fprintf ppf "%s" x
-  | Uconst_int32 x -> fprintf ppf "%ld" x
-  | Uconst_int64 x -> fprintf ppf "%Ld" x
-  | Uconst_nativeint x -> fprintf ppf "%nd" x
+  | Uconst_float x -> fprintf ppf "%F" x
+  | Uconst_int32 x -> fprintf ppf "%ldl" x
+  | Uconst_int64 x -> fprintf ppf "%LdL" x
+  | Uconst_nativeint x -> fprintf ppf "%ndn" x
   | Uconst_block (tag, l) ->
       fprintf ppf "block(%i" tag;
       List.iter (fun u -> fprintf ppf ",%a" uconstant u) l;
       fprintf ppf ")"
-  | Uconst_float_array sl ->
-      fprintf ppf "floatarray(%s)"
-        (String.concat "," sl)
+  | Uconst_float_array [] ->
+      fprintf ppf "floatarray()"
+  | Uconst_float_array (f1 :: fl) ->
+      fprintf ppf "floatarray(%F" f1;
+      List.iter (fun f -> fprintf ppf ",%F" f) fl;
+      fprintf ppf ")"
   | Uconst_string s -> fprintf ppf "%S" s
 
 and uconstant ppf = function
diff --git a/asmcomp/printcmm.ml b/asmcomp/printcmm.ml
index 008081fb47..89c8582aef 100644
--- a/asmcomp/printcmm.ml
+++ b/asmcomp/printcmm.ml
@@ -89,7 +89,7 @@ let rec expr ppf = function
   | Cconst_int n -> fprintf ppf "%i" n
   | Cconst_natint n | Cconst_blockheader n ->
     fprintf ppf "%s" (Nativeint.to_string n)
-  | Cconst_float s -> fprintf ppf "%s" s
+  | Cconst_float n -> fprintf ppf "%F" n
   | Cconst_symbol s -> fprintf ppf "\"%s\"" s
   | Cconst_pointer n -> fprintf ppf "%ia" n
   | Cconst_natpointer n -> fprintf ppf "%sa" (Nativeint.to_string n)
@@ -188,8 +188,8 @@ let data_item ppf = function
   | Cint16 n -> fprintf ppf "int16 %i" n
   | Cint32 n -> fprintf ppf "int32 %s" (Nativeint.to_string n)
   | Cint n -> fprintf ppf "int %s" (Nativeint.to_string n)
-  | Csingle f -> fprintf ppf "single %s" f
-  | Cdouble f -> fprintf ppf "double %s" f
+  | Csingle f -> fprintf ppf "single %F" f
+  | Cdouble f -> fprintf ppf "double %F" f
   | Csymbol_address s -> fprintf ppf "addr \"%s\"" s
   | Clabel_address l -> fprintf ppf "addr L%i" l
   | Cstring s -> fprintf ppf "string \"%s\"" s
diff --git a/asmcomp/printmach.ml b/asmcomp/printmach.ml
index 824665cd9d..a39160d28c 100644
--- a/asmcomp/printmach.ml
+++ b/asmcomp/printmach.ml
@@ -105,7 +105,7 @@ let operation op arg ppf res =
   | Ireload -> fprintf ppf "%a (reload)" regs arg
   | Iconst_int n
   | Iconst_blockheader n -> fprintf ppf "%s" (Nativeint.to_string n)
-  | Iconst_float s -> fprintf ppf "%s" s
+  | Iconst_float f -> fprintf ppf "%F" f
   | Iconst_symbol s -> fprintf ppf "\"%s\"" s
   | Icall_ind -> fprintf ppf "call %a" regs arg
   | Icall_imm lbl -> fprintf ppf "call \"%s\" %a" lbl regs arg
@@ -119,12 +119,13 @@ let operation op arg ppf res =
   | Iload(chunk, addr) ->
       fprintf ppf "%s[%a]"
        (Printcmm.chunk chunk) (Arch.print_addressing reg addr) arg
-  | Istore(chunk, addr) ->
-      fprintf ppf "%s[%a] := %a"
+  | Istore(chunk, addr, is_assign) ->
+      fprintf ppf "%s[%a] := %a %s"
        (Printcmm.chunk chunk)
        (Arch.print_addressing reg addr)
        (Array.sub arg 1 (Array.length arg - 1))
        reg arg.(0)
+       (if is_assign then "(assign)" else "(init)")
   | Ialloc n -> fprintf ppf "alloc %i" n
   | Iintop(op) -> fprintf ppf "%a%s%a" reg arg.(0) (intop op) reg arg.(1)
   | Iintop_imm(op, n) -> fprintf ppf "%a%s%i" reg arg.(0) (intop op) n
diff --git a/asmcomp/proc.mli b/asmcomp/proc.mli
index 6cc6aedc90..cabac4db7c 100644
--- a/asmcomp/proc.mli
+++ b/asmcomp/proc.mli
@@ -40,6 +40,12 @@ val max_register_pressure: Mach.operation -> int array
 val destroyed_at_oper: Mach.instruction_desc -> Reg.t array
 val destroyed_at_raise: Reg.t array
 
+(* Volatile registers: those that change value when read *)
+val regs_are_volatile: Reg.t array -> bool
+
+(* Pure operations *)
+val op_is_pure: Mach.operation -> bool
+
 (* Info for laying out the stack frame *)
 val num_stack_slots: int array
 val contains_calls: bool ref
diff --git a/asmcomp/reg.ml b/asmcomp/reg.ml
index a0fc7dfffa..ef6db5cb6e 100644
--- a/asmcomp/reg.ml
+++ b/asmcomp/reg.ml
@@ -178,6 +178,16 @@ let inter_set_array s v =
            else inter_all(i+1)
          in inter_all 0
 
+let disjoint_set_array s v =
+  match Array.length v with
+    0 -> true
+  | 1 -> not (Set.mem v.(0) s)
+  | n -> let rec disjoint_all i =
+           if i >= n then true
+           else if Set.mem v.(i) s then false
+           else disjoint_all (i+1)
+         in disjoint_all 0
+
 let set_of_array v =
   match Array.length v with
     0 -> Set.empty
diff --git a/asmcomp/reg.mli b/asmcomp/reg.mli
index 34e7498018..e3cb2d9520 100644
--- a/asmcomp/reg.mli
+++ b/asmcomp/reg.mli
@@ -58,6 +58,7 @@ module Map: Map.S with type key = t
 val add_set_array: Set.t -> t array -> Set.t
 val diff_set_array: Set.t -> t array -> Set.t
 val inter_set_array: Set.t -> t array -> Set.t
+val disjoint_set_array: Set.t -> t array -> bool
 val set_of_array: t array -> Set.t
 
 val reset: unit -> unit
diff --git a/asmcomp/schedgen.ml b/asmcomp/schedgen.ml
index e04eacd375..f7af443675 100644
--- a/asmcomp/schedgen.ml
+++ b/asmcomp/schedgen.ml
@@ -138,6 +138,8 @@ let some_load = (Iload(Cmm.Word, Arch.identity_addressing))
 
 class virtual scheduler_generic = object (self)
 
+val mutable trywith_nesting = 0
+
 (* Determine whether an operation ends a basic block or not.
    Can be overridden for some processors to signal specific instructions
    that terminate a basic block. *)
@@ -154,9 +156,16 @@ method oper_in_basic_block = function
 
 (* Determine whether an instruction ends a basic block or not *)
 
-method private instr_in_basic_block instr =
+(* PR#2719: it is generally incorrect to schedule checkbound instructions
+   within a try ... with Invalid_argument _ -> ...
+   Hence, a checkbound instruction within a try...with block ends the
+   current basic block. *)
+
+method private instr_in_basic_block instr try_nesting =
   match instr.desc with
-    Lop op -> self#oper_in_basic_block op
+    Lop op ->
+      self#oper_in_basic_block op &&
+      not (try_nesting > 0 && self#is_checkbound op)
   | Lreloadretaddr -> true
   | _ -> false
 
@@ -165,7 +174,7 @@ method private instr_in_basic_block instr =
    load or store instructions (e.g. on the I386). *)
 
 method is_store = function
-    Istore(_, _) -> true
+    Istore(_, _, _) -> true
   | _ -> false
 
 method is_load = function
@@ -345,19 +354,21 @@ method private reschedule ready_queue date cont =
 
 method schedule_fundecl f =
 
-  let rec schedule i =
+  let rec schedule i try_nesting =
     match i.desc with
-      Lend -> i
+    | Lend -> i
+    | Lpushtrap -> { i with next = schedule i.next (try_nesting + 1) }
+    | Lpoptrap -> { i with next = schedule i.next (try_nesting - 1) }
     | _ ->
-        if self#instr_in_basic_block i then begin
+        if self#instr_in_basic_block i try_nesting then begin
           clear_code_dag();
-          schedule_block [] i
+          schedule_block [] i try_nesting
         end else
-          { i with next = schedule i.next }
+          { i with next = schedule i.next try_nesting }
 
-  and schedule_block ready_queue i =
-    if self#instr_in_basic_block i then
-      schedule_block (self#add_instruction ready_queue i) i.next
+  and schedule_block ready_queue i try_nesting =
+    if self#instr_in_basic_block i try_nesting then
+      schedule_block (self#add_instruction ready_queue i) i.next try_nesting
     else begin
       let critical_outputs =
         match i.desc with
@@ -366,11 +377,11 @@ method schedule_fundecl f =
         | Lreturn -> [||]
         | _ -> i.arg in
       List.iter (fun x -> ignore (longest_path critical_outputs x)) ready_queue;
-      self#reschedule ready_queue 0 (schedule i)
+      self#reschedule ready_queue 0 (schedule i try_nesting)
     end in
 
   if f.fun_fast then begin
-    let new_body = schedule f.fun_body in
+    let new_body = schedule f.fun_body 0 in
     clear_code_dag();
     { fun_name = f.fun_name;
       fun_body = new_body;
@@ -380,3 +391,5 @@ method schedule_fundecl f =
     f
 
 end
+
+let reset () = clear_code_dag ()
diff --git a/asmcomp/schedgen.mli b/asmcomp/schedgen.mli
index 6019d96f42..911330f8ac 100644
--- a/asmcomp/schedgen.mli
+++ b/asmcomp/schedgen.mli
@@ -42,3 +42,5 @@ class virtual scheduler_generic : object
   (* Entry point *)
   method schedule_fundecl : Linearize.fundecl -> Linearize.fundecl
 end
+
+val reset : unit -> unit
diff --git a/asmcomp/selectgen.ml b/asmcomp/selectgen.ml
index a8f073e53a..50a38a244e 100644
--- a/asmcomp/selectgen.ml
+++ b/asmcomp/selectgen.ml
@@ -209,8 +209,8 @@ method virtual select_addressing :
 
 (* Default instruction selection for stores (of words) *)
 
-method select_store addr arg =
-  (Istore(Word, addr), arg)
+method select_store is_assign addr arg =
+  (Istore(Word, addr, is_assign), arg)
 
 (* call marking methods, documented in selectgen.mli *)
 
@@ -256,10 +256,10 @@ method select_operation op args =
   | (Cstore chunk, [arg1; arg2]) ->
       let (addr, eloc) = self#select_addressing chunk arg1 in
       if chunk = Word then begin
-        let (op, newarg2) = self#select_store addr arg2 in
+        let (op, newarg2) = self#select_store true addr arg2 in
         (op, [newarg2; eloc])
       end else begin
-        (Istore(chunk, addr), [arg2; eloc])
+        (Istore(chunk, addr, true), [arg2; eloc])
         (* Inversion addr/datum in Istore *)
       end
   | (Calloc, _) -> (Ialloc 0, args)
@@ -677,16 +677,16 @@ method emit_stores env data regs_addr =
     ref (Arch.offset_addressing Arch.identity_addressing (-Arch.size_int)) in
   List.iter
     (fun e ->
-      let (op, arg) = self#select_store !a e in
+      let (op, arg) = self#select_store false !a e in
       match self#emit_expr env arg with
         None -> assert false
       | Some regs ->
           match op with
-            Istore(_, _) ->
+            Istore(_, _, _) ->
               for i = 0 to Array.length regs - 1 do
                 let r = regs.(i) in
                 let kind = if r.typ = Float then Double_u else Word in
-                self#insert (Iop(Istore(kind, !a)))
+                self#insert (Iop(Istore(kind, !a, false)))
                             (Array.append [|r|] regs_addr) [||];
                 a := Arch.offset_addressing !a (size_component r.typ)
               done
@@ -857,3 +857,7 @@ let is_tail_call nargs =
 
 let _ =
   Simplif.is_tail_native_heuristic := is_tail_call
+
+let reset () =
+  catch_regs := [];
+  current_function_name := ""
diff --git a/asmcomp/selectgen.mli b/asmcomp/selectgen.mli
index 7012c900cc..0de9038215 100644
--- a/asmcomp/selectgen.mli
+++ b/asmcomp/selectgen.mli
@@ -35,7 +35,8 @@ class virtual selector_generic : object
   method select_condition : Cmm.expression -> Mach.test * Cmm.expression
     (* Can be overridden to deal with special test instructions *)
   method select_store :
-    Arch.addressing_mode -> Cmm.expression -> Mach.operation * Cmm.expression
+    bool -> Arch.addressing_mode -> Cmm.expression ->
+                                         Mach.operation * Cmm.expression
     (* Can be overridden to deal with special store constant instructions *)
   method regs_for : Cmm.machtype -> Reg.t array
     (* Return an array of fresh registers of the given type.
@@ -100,3 +101,5 @@ class virtual selector_generic : object
     (Ident.t, Reg.t array) Tbl.t -> Cmm.expression -> Reg.t array option
   method emit_tail : (Ident.t, Reg.t array) Tbl.t -> Cmm.expression -> unit
 end
+
+val reset : unit -> unit
diff --git a/asmcomp/sparc/CSE.ml b/asmcomp/sparc/CSE.ml
new file mode 100644
index 0000000000..c38bab8fe1
--- /dev/null
+++ b/asmcomp/sparc/CSE.ml
@@ -0,0 +1,31 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Gallium, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 2014 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.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* CSE for Sparc *)
+
+open Mach
+open CSEgen
+
+class cse = object (self)
+
+inherit cse_generic (* as super *)
+
+method! is_cheap_operation op =
+  match op with
+  | Iconst_int n | Iconst_blockheader n -> n <= 4095n && n >= -4096n
+  | _ -> false
+
+end
+
+let fundecl f =
+  (new cse)#fundecl f
+
diff --git a/asmcomp/sparc/emit.mlp b/asmcomp/sparc/emit.mlp
index 12d60ed327..877a3d52a0 100644
--- a/asmcomp/sparc/emit.mlp
+++ b/asmcomp/sparc/emit.mlp
@@ -190,7 +190,7 @@ let emit_frame fd =
 
 (* Record floating-point constants *)
 
-let float_constants = ref ([] : (int * string) list)
+let float_constants = ref ([] : (int * int64) list)
 
 let emit_float_constant (lbl, cst) =
   rodata ();
@@ -309,11 +309,11 @@ let rec emit_instr i dslot =
           `	sethi	%hi({emit_nativeint n}), %g1\n`;
           `	or	%g1, %lo({emit_nativeint n}), {emit_reg i.res.(0)}\n`
         end
-    | Lop(Iconst_float s) ->
+    | Lop(Iconst_float f) ->
         (* On UltraSPARC, the fzero instruction could be used to set a
            floating point register pair to zero. *)
         let lbl = new_label() in
-        float_constants := (lbl, s) :: !float_constants;
+        float_constants := (lbl, Int64.bits_of_float f) :: !float_constants;
         `	sethi	%hi({emit_label lbl}), %g1\n`;
         `	ldd	[%g1 + %lo({emit_label lbl})], {emit_reg i.res.(0)}\n`
     | Lop(Iconst_symbol s) ->
@@ -375,7 +375,7 @@ let rec emit_instr i dslot =
               | _ -> "ld" in
             emit_load loadinstr addr i.arg dest
         end
-    | Lop(Istore(chunk, addr)) ->
+    | Lop(Istore(chunk, addr, _)) ->
         let src = i.arg.(0) in
         begin match chunk with
           Double_u ->
@@ -612,7 +612,7 @@ let is_one_instr i =
       | Iconst_int n | Iconst_blockheader n -> is_native_immediate n
       | Istackoffset _ -> true
       | Iload(_, Iindexed n) -> i.res.(0).typ <> Float && is_immediate n
-      | Istore(_, Iindexed n) -> i.arg.(0).typ <> Float && is_immediate n
+      | Istore(_, Iindexed n, _) -> i.arg.(0).typ <> Float && is_immediate n
       | Iintop(op) -> is_one_instr_op op
       | Iintop_imm(op, _) -> is_one_instr_op op
       | Iaddf | Isubf | Imulf | Idivf -> true
@@ -706,9 +706,9 @@ let emit_item = function
   | Cint n ->
       `	.word	{emit_nativeint n}\n`
   | Csingle f ->
-      emit_float32_directive ".word" f
+      emit_float32_directive ".word" (Int32.bits_of_float f)
   | Cdouble f ->
-      emit_float64_split_directive ".word" f
+      emit_float64_split_directive ".word" (Int64.bits_of_float f)
   | Csymbol_address s ->
       `	.word	{emit_symbol s}\n`
   | Clabel_address lbl ->
diff --git a/asmcomp/sparc/proc.ml b/asmcomp/sparc/proc.ml
index ed107a82a7..ff353d6283 100644
--- a/asmcomp/sparc/proc.ml
+++ b/asmcomp/sparc/proc.ml
@@ -171,6 +171,10 @@ let loc_external_results res =
 
 let loc_exn_bucket = phys_reg 0         (* $o0 *)
 
+(* Volatile registers: none *)
+
+let regs_are_volatile rs = false
+
 (* Registers destroyed by operations *)
 
 let destroyed_at_c_call = (* %l0-%l4, %i0-%i5 preserved *)
@@ -196,6 +200,15 @@ let max_register_pressure = function
     Iextcall(_, _) -> [| 11; 0 |]
   | _ -> [| 19; 15 |]
 
+(* Pure operations (without any side effect besides updating their result
+   registers). *)
+
+let op_is_pure = function
+  | Icall_ind | Icall_imm _ | Itailcall_ind | Itailcall_imm _
+  | Iextcall _ | Istackoffset _ | Istore _ | Ialloc _
+  | Iintop(Icheckbound) | Iintop_imm(Icheckbound, _) -> false
+  | _ -> true
+
 (* Layout of the stack *)
 
 let num_stack_slots = [| 0; 0 |]
diff --git a/asmcomp/spill.ml b/asmcomp/spill.ml
index ca17fe5bf6..36d1e6812d 100644
--- a/asmcomp/spill.ml
+++ b/asmcomp/spill.ml
@@ -233,7 +233,12 @@ let rec reload i before =
       (i, Reg.Set.empty)
   | Itrywith(body, handler) ->
       let (new_body, after_body) = reload body before in
-      let (new_handler, after_handler) = reload handler handler.live in
+      (* All registers live at the beginning of the handler are destroyed,
+         except the exception bucket *)
+      let before_handler =
+        Reg.Set.remove Proc.loc_exn_bucket
+                       (Reg.add_set_array handler.live handler.arg) in
+      let (new_handler, after_handler) = reload handler before_handler in
       let (new_next, finally) =
         reload i.next (Reg.Set.union after_body after_handler) in
       (instr_cons (Itrywith(new_body, new_handler)) i.arg i.res new_next,
@@ -384,10 +389,14 @@ let rec spill i finally =
 
 (* Entry point *)
 
-let fundecl f =
+let reset () =
   spill_env := Reg.Map.empty;
   use_date := Reg.Map.empty;
-  current_date := 0;
+  current_date := 0
+
+let fundecl f =
+  reset ();
+
   let (body1, _) = reload f.fun_body Reg.Set.empty in
   let (body2, tospill_at_entry) = spill body1 Reg.Set.empty in
   let new_body =
diff --git a/asmcomp/spill.mli b/asmcomp/spill.mli
index 66954aef5b..598a175522 100644
--- a/asmcomp/spill.mli
+++ b/asmcomp/spill.mli
@@ -14,3 +14,4 @@
    before register allocation. *)
 
 val fundecl: Mach.fundecl -> Mach.fundecl
+val reset : unit -> unit
diff --git a/asmcomp/split.ml b/asmcomp/split.ml
index 9e076e6481..919c980dce 100644
--- a/asmcomp/split.ml
+++ b/asmcomp/split.ml
@@ -195,8 +195,13 @@ let set_repres i =
 
 (* Entry point *)
 
-let fundecl f =
+let reset () =
   equiv_classes := Reg.Map.empty;
+  exit_subst := []
+
+let fundecl f =
+  reset ();
+
   let new_args = Array.copy f.fun_args in
   let (new_body, sub_body) = rename f.fun_body (Some Reg.Map.empty) in
   repres_regs new_args;
diff --git a/asmcomp/split.mli b/asmcomp/split.mli
index f794fec16f..1924a5ad6c 100644
--- a/asmcomp/split.mli
+++ b/asmcomp/split.mli
@@ -13,3 +13,5 @@
 (* Renaming of registers at reload points to split live ranges. *)
 
 val fundecl: Mach.fundecl -> Mach.fundecl
+
+val reset : unit -> unit
diff --git a/asmrun/.depend b/asmrun/.depend
index bec9f0c076..5ddaa0d396 100644
--- a/asmrun/.depend
+++ b/asmrun/.depend
@@ -1,756 +1,756 @@
 alloc.o: alloc.c ../byterun/alloc.h ../byterun/misc.h ../byterun/config.h \
- ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
- ../byterun/custom.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \
- ../byterun/minor_gc.h ../byterun/mlvalues.h ../byterun/stacks.h \
- ../byterun/memory.h
+  ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
+  ../byterun/custom.h ../byterun/major_gc.h ../byterun/freelist.h \
+  ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \
+  ../byterun/minor_gc.h ../byterun/mlvalues.h ../byterun/stacks.h \
+  ../byterun/memory.h
 array.o: array.c ../byterun/alloc.h ../byterun/misc.h ../byterun/config.h \
- ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
- ../byterun/fail.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/misc.h ../byterun/mlvalues.h
+  ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
+  ../byterun/fail.h ../byterun/memory.h ../byterun/gc.h \
+  ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
+  ../byterun/misc.h ../byterun/mlvalues.h
 backtrace.o: backtrace.c ../byterun/alloc.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/mlvalues.h ../byterun/backtrace.h ../byterun/memory.h \
- ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/minor_gc.h ../byterun/misc.h ../byterun/mlvalues.h stack.h
+  ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
+  ../byterun/mlvalues.h ../byterun/backtrace.h ../byterun/memory.h \
+  ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \
+  ../byterun/minor_gc.h ../byterun/misc.h ../byterun/mlvalues.h stack.h
 callback.o: callback.c ../byterun/callback.h ../byterun/mlvalues.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/misc.h ../byterun/fail.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/mlvalues.h
+  ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
+  ../byterun/misc.h ../byterun/fail.h ../byterun/memory.h ../byterun/gc.h \
+  ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
+  ../byterun/mlvalues.h
 compact.o: compact.c ../byterun/config.h ../byterun/../config/m.h \
- ../byterun/../config/s.h ../byterun/finalise.h ../byterun/roots.h \
- ../byterun/misc.h ../byterun/config.h ../byterun/memory.h \
- ../byterun/gc.h ../byterun/mlvalues.h ../byterun/major_gc.h \
- ../byterun/freelist.h ../byterun/minor_gc.h ../byterun/freelist.h \
- ../byterun/gc.h ../byterun/gc_ctrl.h ../byterun/major_gc.h \
- ../byterun/memory.h ../byterun/mlvalues.h ../byterun/roots.h \
- ../byterun/weak.h
+  ../byterun/../config/s.h ../byterun/finalise.h ../byterun/roots.h \
+  ../byterun/misc.h ../byterun/config.h ../byterun/memory.h \
+  ../byterun/gc.h ../byterun/mlvalues.h ../byterun/major_gc.h \
+  ../byterun/freelist.h ../byterun/minor_gc.h ../byterun/freelist.h \
+  ../byterun/gc.h ../byterun/gc_ctrl.h ../byterun/major_gc.h \
+  ../byterun/memory.h ../byterun/mlvalues.h ../byterun/roots.h \
+  ../byterun/weak.h
 compare.o: compare.c ../byterun/custom.h ../byterun/mlvalues.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/misc.h ../byterun/fail.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/misc.h ../byterun/mlvalues.h
+  ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
+  ../byterun/misc.h ../byterun/fail.h ../byterun/memory.h ../byterun/gc.h \
+  ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
+  ../byterun/misc.h ../byterun/mlvalues.h
 custom.o: custom.c ../byterun/alloc.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/mlvalues.h ../byterun/custom.h ../byterun/fail.h \
- ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \
- ../byterun/freelist.h ../byterun/minor_gc.h ../byterun/mlvalues.h
+  ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
+  ../byterun/mlvalues.h ../byterun/custom.h ../byterun/fail.h \
+  ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \
+  ../byterun/freelist.h ../byterun/minor_gc.h ../byterun/mlvalues.h
 debugger.o: debugger.c ../byterun/alloc.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/mlvalues.h ../byterun/config.h ../byterun/debugger.h \
- ../byterun/misc.h
+  ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
+  ../byterun/mlvalues.h ../byterun/config.h ../byterun/debugger.h \
+  ../byterun/misc.h
 dynlink.o: dynlink.c ../byterun/config.h ../byterun/../config/m.h \
- ../byterun/../config/s.h ../byterun/alloc.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/mlvalues.h ../byterun/dynlink.h \
- ../byterun/fail.h ../byterun/mlvalues.h ../byterun/memory.h \
- ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/minor_gc.h ../byterun/misc.h ../byterun/osdeps.h \
- ../byterun/prims.h
+  ../byterun/../config/s.h ../byterun/alloc.h ../byterun/misc.h \
+  ../byterun/config.h ../byterun/mlvalues.h ../byterun/dynlink.h \
+  ../byterun/fail.h ../byterun/mlvalues.h ../byterun/memory.h \
+  ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \
+  ../byterun/minor_gc.h ../byterun/misc.h ../byterun/osdeps.h \
+  ../byterun/prims.h
 extern.o: extern.c ../byterun/alloc.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/mlvalues.h ../byterun/custom.h ../byterun/fail.h \
- ../byterun/gc.h ../byterun/intext.h ../byterun/io.h ../byterun/io.h \
- ../byterun/md5.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/misc.h ../byterun/mlvalues.h ../byterun/reverse.h
+  ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
+  ../byterun/mlvalues.h ../byterun/custom.h ../byterun/fail.h \
+  ../byterun/gc.h ../byterun/intext.h ../byterun/io.h ../byterun/io.h \
+  ../byterun/md5.h ../byterun/memory.h ../byterun/gc.h \
+  ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
+  ../byterun/misc.h ../byterun/mlvalues.h ../byterun/reverse.h
 fail.o: fail.c ../byterun/alloc.h ../byterun/misc.h ../byterun/config.h \
- ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
- ../byterun/fail.h ../byterun/io.h ../byterun/gc.h ../byterun/memory.h \
- ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/minor_gc.h ../byterun/mlvalues.h ../byterun/printexc.h \
- ../byterun/signals.h stack.h ../byterun/roots.h ../byterun/memory.h \
- ../byterun/callback.h
+  ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
+  ../byterun/fail.h ../byterun/io.h ../byterun/gc.h ../byterun/memory.h \
+  ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \
+  ../byterun/minor_gc.h ../byterun/mlvalues.h ../byterun/printexc.h \
+  ../byterun/signals.h stack.h ../byterun/roots.h ../byterun/memory.h \
+  ../byterun/callback.h
 finalise.o: finalise.c ../byterun/callback.h ../byterun/mlvalues.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/misc.h ../byterun/fail.h ../byterun/mlvalues.h \
- ../byterun/roots.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/signals.h
+  ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
+  ../byterun/misc.h ../byterun/fail.h ../byterun/mlvalues.h \
+  ../byterun/roots.h ../byterun/memory.h ../byterun/gc.h \
+  ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
+  ../byterun/signals.h
 floats.o: floats.c ../byterun/alloc.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/mlvalues.h ../byterun/fail.h ../byterun/memory.h \
- ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/minor_gc.h ../byterun/mlvalues.h ../byterun/misc.h \
- ../byterun/reverse.h ../byterun/stacks.h ../byterun/memory.h
+  ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
+  ../byterun/mlvalues.h ../byterun/fail.h ../byterun/memory.h \
+  ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \
+  ../byterun/minor_gc.h ../byterun/mlvalues.h ../byterun/misc.h \
+  ../byterun/reverse.h ../byterun/stacks.h ../byterun/memory.h
 freelist.o: freelist.c ../byterun/config.h ../byterun/../config/m.h \
- ../byterun/../config/s.h ../byterun/freelist.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/mlvalues.h ../byterun/gc.h \
- ../byterun/gc_ctrl.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/major_gc.h ../byterun/misc.h ../byterun/mlvalues.h
+  ../byterun/../config/s.h ../byterun/freelist.h ../byterun/misc.h \
+  ../byterun/config.h ../byterun/mlvalues.h ../byterun/gc.h \
+  ../byterun/gc_ctrl.h ../byterun/memory.h ../byterun/gc.h \
+  ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
+  ../byterun/major_gc.h ../byterun/misc.h ../byterun/mlvalues.h
 gc_ctrl.o: gc_ctrl.c ../byterun/alloc.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/mlvalues.h ../byterun/compact.h ../byterun/custom.h \
- ../byterun/finalise.h ../byterun/roots.h ../byterun/memory.h \
- ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/minor_gc.h ../byterun/freelist.h ../byterun/gc.h \
- ../byterun/gc_ctrl.h ../byterun/major_gc.h ../byterun/minor_gc.h \
- ../byterun/misc.h ../byterun/mlvalues.h stack.h
+  ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
+  ../byterun/mlvalues.h ../byterun/compact.h ../byterun/custom.h \
+  ../byterun/finalise.h ../byterun/roots.h ../byterun/memory.h \
+  ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \
+  ../byterun/minor_gc.h ../byterun/freelist.h ../byterun/gc.h \
+  ../byterun/gc_ctrl.h ../byterun/major_gc.h ../byterun/minor_gc.h \
+  ../byterun/misc.h ../byterun/mlvalues.h stack.h
 globroots.o: globroots.c ../byterun/memory.h ../byterun/config.h \
- ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/gc.h \
- ../byterun/mlvalues.h ../byterun/misc.h ../byterun/major_gc.h \
- ../byterun/freelist.h ../byterun/minor_gc.h ../byterun/misc.h \
- ../byterun/mlvalues.h ../byterun/roots.h ../byterun/memory.h \
- ../byterun/globroots.h ../byterun/roots.h
+  ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/gc.h \
+  ../byterun/mlvalues.h ../byterun/misc.h ../byterun/major_gc.h \
+  ../byterun/freelist.h ../byterun/minor_gc.h ../byterun/misc.h \
+  ../byterun/mlvalues.h ../byterun/roots.h ../byterun/memory.h \
+  ../byterun/globroots.h ../byterun/roots.h
 hash.o: hash.c ../byterun/mlvalues.h ../byterun/config.h \
- ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/misc.h \
- ../byterun/custom.h ../byterun/mlvalues.h ../byterun/memory.h \
- ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/minor_gc.h ../byterun/hash.h ../byterun/int64_native.h
+  ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/misc.h \
+  ../byterun/custom.h ../byterun/mlvalues.h ../byterun/memory.h \
+  ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \
+  ../byterun/minor_gc.h ../byterun/hash.h ../byterun/int64_native.h
 intern.o: intern.c ../byterun/alloc.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/mlvalues.h ../byterun/callback.h ../byterun/custom.h \
- ../byterun/fail.h ../byterun/gc.h ../byterun/intext.h ../byterun/io.h \
- ../byterun/io.h ../byterun/md5.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/mlvalues.h ../byterun/misc.h ../byterun/reverse.h
+  ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
+  ../byterun/mlvalues.h ../byterun/callback.h ../byterun/custom.h \
+  ../byterun/fail.h ../byterun/gc.h ../byterun/intext.h ../byterun/io.h \
+  ../byterun/io.h ../byterun/md5.h ../byterun/memory.h ../byterun/gc.h \
+  ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
+  ../byterun/mlvalues.h ../byterun/misc.h ../byterun/reverse.h
 ints.o: ints.c ../byterun/alloc.h ../byterun/misc.h ../byterun/config.h \
- ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
- ../byterun/custom.h ../byterun/fail.h ../byterun/intext.h \
- ../byterun/io.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/misc.h ../byterun/mlvalues.h ../byterun/int64_native.h
+  ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
+  ../byterun/custom.h ../byterun/fail.h ../byterun/intext.h \
+  ../byterun/io.h ../byterun/memory.h ../byterun/gc.h \
+  ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
+  ../byterun/misc.h ../byterun/mlvalues.h ../byterun/int64_native.h
 io.o: io.c ../byterun/config.h ../byterun/../config/m.h \
- ../byterun/../config/s.h ../byterun/alloc.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/mlvalues.h ../byterun/custom.h \
- ../byterun/fail.h ../byterun/io.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/misc.h ../byterun/mlvalues.h ../byterun/signals.h \
- ../byterun/sys.h
+  ../byterun/../config/s.h ../byterun/alloc.h ../byterun/misc.h \
+  ../byterun/config.h ../byterun/mlvalues.h ../byterun/custom.h \
+  ../byterun/fail.h ../byterun/io.h ../byterun/memory.h ../byterun/gc.h \
+  ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
+  ../byterun/misc.h ../byterun/mlvalues.h ../byterun/signals.h \
+  ../byterun/sys.h
 lexing.o: lexing.c ../byterun/fail.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/mlvalues.h ../byterun/mlvalues.h ../byterun/stacks.h \
- ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \
- ../byterun/freelist.h ../byterun/minor_gc.h
+  ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
+  ../byterun/mlvalues.h ../byterun/mlvalues.h ../byterun/stacks.h \
+  ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \
+  ../byterun/freelist.h ../byterun/minor_gc.h
 main.o: main.c ../byterun/misc.h ../byterun/config.h \
- ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
- ../byterun/misc.h ../byterun/sys.h
+  ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
+  ../byterun/misc.h ../byterun/sys.h
 major_gc.o: major_gc.c ../byterun/compact.h ../byterun/config.h \
- ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/misc.h \
- ../byterun/custom.h ../byterun/mlvalues.h ../byterun/config.h \
- ../byterun/fail.h ../byterun/finalise.h ../byterun/roots.h \
- ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \
- ../byterun/freelist.h ../byterun/minor_gc.h ../byterun/freelist.h \
- ../byterun/gc.h ../byterun/gc_ctrl.h ../byterun/major_gc.h \
- ../byterun/misc.h ../byterun/mlvalues.h ../byterun/roots.h \
- ../byterun/weak.h
+  ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/misc.h \
+  ../byterun/custom.h ../byterun/mlvalues.h ../byterun/config.h \
+  ../byterun/fail.h ../byterun/finalise.h ../byterun/roots.h \
+  ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \
+  ../byterun/freelist.h ../byterun/minor_gc.h ../byterun/freelist.h \
+  ../byterun/gc.h ../byterun/gc_ctrl.h ../byterun/major_gc.h \
+  ../byterun/misc.h ../byterun/mlvalues.h ../byterun/roots.h \
+  ../byterun/weak.h
 md5.o: md5.c ../byterun/alloc.h ../byterun/misc.h ../byterun/config.h \
- ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
- ../byterun/fail.h ../byterun/md5.h ../byterun/io.h ../byterun/memory.h \
- ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/minor_gc.h ../byterun/mlvalues.h ../byterun/io.h \
- ../byterun/reverse.h
+  ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
+  ../byterun/fail.h ../byterun/md5.h ../byterun/io.h ../byterun/memory.h \
+  ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \
+  ../byterun/minor_gc.h ../byterun/mlvalues.h ../byterun/io.h \
+  ../byterun/reverse.h
 memory.o: memory.c ../byterun/fail.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/mlvalues.h ../byterun/freelist.h ../byterun/gc.h \
- ../byterun/gc_ctrl.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \
- ../byterun/minor_gc.h ../byterun/minor_gc.h ../byterun/misc.h \
- ../byterun/mlvalues.h ../byterun/signals.h
+  ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
+  ../byterun/mlvalues.h ../byterun/freelist.h ../byterun/gc.h \
+  ../byterun/gc_ctrl.h ../byterun/major_gc.h ../byterun/freelist.h \
+  ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \
+  ../byterun/minor_gc.h ../byterun/minor_gc.h ../byterun/misc.h \
+  ../byterun/mlvalues.h ../byterun/signals.h
 meta.o: meta.c ../byterun/alloc.h ../byterun/misc.h ../byterun/config.h \
- ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
- ../byterun/config.h ../byterun/fail.h ../byterun/fix_code.h \
- ../byterun/interp.h ../byterun/intext.h ../byterun/io.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/memory.h \
- ../byterun/gc.h ../byterun/major_gc.h ../byterun/minor_gc.h \
- ../byterun/minor_gc.h ../byterun/misc.h ../byterun/mlvalues.h \
- ../byterun/prims.h ../byterun/stacks.h ../byterun/memory.h
+  ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
+  ../byterun/config.h ../byterun/fail.h ../byterun/fix_code.h \
+  ../byterun/interp.h ../byterun/intext.h ../byterun/io.h \
+  ../byterun/major_gc.h ../byterun/freelist.h ../byterun/memory.h \
+  ../byterun/gc.h ../byterun/major_gc.h ../byterun/minor_gc.h \
+  ../byterun/minor_gc.h ../byterun/misc.h ../byterun/mlvalues.h \
+  ../byterun/prims.h ../byterun/stacks.h ../byterun/memory.h
 minor_gc.o: minor_gc.c ../byterun/config.h ../byterun/../config/m.h \
- ../byterun/../config/s.h ../byterun/fail.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/mlvalues.h ../byterun/finalise.h \
- ../byterun/roots.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/gc.h ../byterun/gc_ctrl.h ../byterun/major_gc.h \
- ../byterun/memory.h ../byterun/minor_gc.h ../byterun/misc.h \
- ../byterun/mlvalues.h ../byterun/roots.h ../byterun/signals.h \
- ../byterun/weak.h
+  ../byterun/../config/s.h ../byterun/fail.h ../byterun/misc.h \
+  ../byterun/config.h ../byterun/mlvalues.h ../byterun/finalise.h \
+  ../byterun/roots.h ../byterun/memory.h ../byterun/gc.h \
+  ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
+  ../byterun/gc.h ../byterun/gc_ctrl.h ../byterun/major_gc.h \
+  ../byterun/memory.h ../byterun/minor_gc.h ../byterun/misc.h \
+  ../byterun/mlvalues.h ../byterun/roots.h ../byterun/signals.h \
+  ../byterun/weak.h
 misc.o: misc.c ../byterun/config.h ../byterun/../config/m.h \
- ../byterun/../config/s.h ../byterun/misc.h ../byterun/config.h \
- ../byterun/memory.h ../byterun/gc.h ../byterun/mlvalues.h \
- ../byterun/misc.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/minor_gc.h
+  ../byterun/../config/s.h ../byterun/misc.h ../byterun/config.h \
+  ../byterun/memory.h ../byterun/gc.h ../byterun/mlvalues.h \
+  ../byterun/misc.h ../byterun/major_gc.h ../byterun/freelist.h \
+  ../byterun/minor_gc.h
 natdynlink.o: natdynlink.c ../byterun/misc.h ../byterun/config.h \
- ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
- ../byterun/misc.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/mlvalues.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/minor_gc.h stack.h ../byterun/callback.h ../byterun/alloc.h \
- ../byterun/intext.h ../byterun/io.h ../byterun/osdeps.h \
- ../byterun/fail.h
+  ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
+  ../byterun/misc.h ../byterun/memory.h ../byterun/gc.h \
+  ../byterun/mlvalues.h ../byterun/major_gc.h ../byterun/freelist.h \
+  ../byterun/minor_gc.h stack.h ../byterun/callback.h ../byterun/alloc.h \
+  ../byterun/intext.h ../byterun/io.h ../byterun/osdeps.h \
+  ../byterun/fail.h
 obj.o: obj.c ../byterun/alloc.h ../byterun/misc.h ../byterun/config.h \
- ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
- ../byterun/fail.h ../byterun/gc.h ../byterun/interp.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/memory.h \
- ../byterun/gc.h ../byterun/major_gc.h ../byterun/minor_gc.h \
- ../byterun/minor_gc.h ../byterun/misc.h ../byterun/mlvalues.h \
- ../byterun/prims.h
+  ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
+  ../byterun/fail.h ../byterun/gc.h ../byterun/interp.h \
+  ../byterun/major_gc.h ../byterun/freelist.h ../byterun/memory.h \
+  ../byterun/gc.h ../byterun/major_gc.h ../byterun/minor_gc.h \
+  ../byterun/minor_gc.h ../byterun/misc.h ../byterun/mlvalues.h \
+  ../byterun/prims.h
 parsing.o: parsing.c ../byterun/config.h ../byterun/../config/m.h \
- ../byterun/../config/s.h ../byterun/mlvalues.h ../byterun/config.h \
- ../byterun/misc.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/mlvalues.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/minor_gc.h ../byterun/alloc.h
+  ../byterun/../config/s.h ../byterun/mlvalues.h ../byterun/config.h \
+  ../byterun/misc.h ../byterun/memory.h ../byterun/gc.h \
+  ../byterun/mlvalues.h ../byterun/major_gc.h ../byterun/freelist.h \
+  ../byterun/minor_gc.h ../byterun/alloc.h
 printexc.o: printexc.c ../byterun/backtrace.h ../byterun/mlvalues.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/misc.h ../byterun/callback.h ../byterun/debugger.h \
- ../byterun/fail.h ../byterun/misc.h ../byterun/mlvalues.h \
- ../byterun/printexc.h
+  ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
+  ../byterun/misc.h ../byterun/callback.h ../byterun/debugger.h \
+  ../byterun/fail.h ../byterun/misc.h ../byterun/mlvalues.h \
+  ../byterun/printexc.h
 roots.o: roots.c ../byterun/finalise.h ../byterun/roots.h \
- ../byterun/misc.h ../byterun/config.h ../byterun/../config/m.h \
- ../byterun/../config/s.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/mlvalues.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/minor_gc.h ../byterun/globroots.h ../byterun/memory.h \
- ../byterun/major_gc.h ../byterun/minor_gc.h ../byterun/misc.h \
- ../byterun/mlvalues.h stack.h ../byterun/roots.h
+  ../byterun/misc.h ../byterun/config.h ../byterun/../config/m.h \
+  ../byterun/../config/s.h ../byterun/memory.h ../byterun/gc.h \
+  ../byterun/mlvalues.h ../byterun/major_gc.h ../byterun/freelist.h \
+  ../byterun/minor_gc.h ../byterun/globroots.h ../byterun/memory.h \
+  ../byterun/major_gc.h ../byterun/minor_gc.h ../byterun/misc.h \
+  ../byterun/mlvalues.h stack.h ../byterun/roots.h
 signals.o: signals.c ../byterun/alloc.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/mlvalues.h ../byterun/callback.h ../byterun/config.h \
- ../byterun/fail.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/misc.h ../byterun/mlvalues.h ../byterun/roots.h \
- ../byterun/memory.h ../byterun/signals.h ../byterun/signals_machdep.h \
- ../byterun/sys.h
+  ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
+  ../byterun/mlvalues.h ../byterun/callback.h ../byterun/config.h \
+  ../byterun/fail.h ../byterun/memory.h ../byterun/gc.h \
+  ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
+  ../byterun/misc.h ../byterun/mlvalues.h ../byterun/roots.h \
+  ../byterun/memory.h ../byterun/signals.h ../byterun/signals_machdep.h \
+  ../byterun/sys.h
 signals_asm.o: signals_asm.c ../byterun/fail.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/mlvalues.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/osdeps.h ../byterun/signals.h ../byterun/signals_machdep.h \
- signals_osdep.h stack.h
+  ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
+  ../byterun/mlvalues.h ../byterun/memory.h ../byterun/gc.h \
+  ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
+  ../byterun/osdeps.h ../byterun/signals.h ../byterun/signals_machdep.h \
+  signals_osdep.h stack.h
 startup.o: startup.c ../byterun/callback.h ../byterun/mlvalues.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/misc.h ../byterun/backtrace.h ../byterun/custom.h \
- ../byterun/debugger.h ../byterun/fail.h ../byterun/freelist.h \
- ../byterun/gc.h ../byterun/gc_ctrl.h ../byterun/intext.h ../byterun/io.h \
- ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \
- ../byterun/freelist.h ../byterun/minor_gc.h ../byterun/misc.h \
- ../byterun/mlvalues.h ../byterun/osdeps.h ../byterun/printexc.h stack.h \
- ../byterun/sys.h
+  ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
+  ../byterun/misc.h ../byterun/backtrace.h ../byterun/custom.h \
+  ../byterun/debugger.h ../byterun/fail.h ../byterun/freelist.h \
+  ../byterun/gc.h ../byterun/gc_ctrl.h ../byterun/intext.h \
+  ../byterun/io.h ../byterun/memory.h ../byterun/gc.h \
+  ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
+  ../byterun/misc.h ../byterun/mlvalues.h ../byterun/osdeps.h \
+  ../byterun/printexc.h stack.h ../byterun/sys.h
 str.o: str.c ../byterun/alloc.h ../byterun/misc.h ../byterun/config.h \
- ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
- ../byterun/fail.h ../byterun/mlvalues.h ../byterun/misc.h \
- ../byterun/int64_native.h
+  ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
+  ../byterun/fail.h ../byterun/mlvalues.h ../byterun/misc.h \
+  ../byterun/int64_native.h
 sys.o: sys.c ../byterun/config.h ../byterun/../config/m.h \
- ../byterun/../config/s.h ../byterun/alloc.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/mlvalues.h ../byterun/debugger.h \
- ../byterun/fail.h ../byterun/instruct.h ../byterun/mlvalues.h \
- ../byterun/osdeps.h ../byterun/signals.h ../byterun/stacks.h \
- ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \
- ../byterun/freelist.h ../byterun/minor_gc.h ../byterun/sys.h
+  ../byterun/../config/s.h ../byterun/alloc.h ../byterun/misc.h \
+  ../byterun/config.h ../byterun/mlvalues.h ../byterun/debugger.h \
+  ../byterun/fail.h ../byterun/instruct.h ../byterun/mlvalues.h \
+  ../byterun/osdeps.h ../byterun/signals.h ../byterun/stacks.h \
+  ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \
+  ../byterun/freelist.h ../byterun/minor_gc.h ../byterun/sys.h
 terminfo.o: terminfo.c ../byterun/config.h ../byterun/../config/m.h \
- ../byterun/../config/s.h ../byterun/alloc.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/mlvalues.h ../byterun/fail.h \
- ../byterun/io.h ../byterun/mlvalues.h
+  ../byterun/../config/s.h ../byterun/alloc.h ../byterun/misc.h \
+  ../byterun/config.h ../byterun/mlvalues.h ../byterun/fail.h \
+  ../byterun/io.h ../byterun/mlvalues.h
 unix.o: unix.c ../byterun/config.h ../byterun/../config/m.h \
- ../byterun/../config/s.h ../byterun/memory.h ../byterun/config.h \
- ../byterun/gc.h ../byterun/mlvalues.h ../byterun/misc.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/misc.h ../byterun/osdeps.h
+  ../byterun/../config/s.h ../byterun/memory.h ../byterun/config.h \
+  ../byterun/gc.h ../byterun/mlvalues.h ../byterun/misc.h \
+  ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
+  ../byterun/misc.h ../byterun/osdeps.h
 weak.o: weak.c ../byterun/alloc.h ../byterun/misc.h ../byterun/config.h \
- ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
- ../byterun/fail.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \
- ../byterun/minor_gc.h ../byterun/mlvalues.h
+  ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
+  ../byterun/fail.h ../byterun/major_gc.h ../byterun/freelist.h \
+  ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \
+  ../byterun/minor_gc.h ../byterun/mlvalues.h
 alloc.d.o: alloc.c ../byterun/alloc.h ../byterun/misc.h ../byterun/config.h \
- ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
- ../byterun/custom.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \
- ../byterun/minor_gc.h ../byterun/mlvalues.h ../byterun/stacks.h \
- ../byterun/memory.h
+  ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
+  ../byterun/custom.h ../byterun/major_gc.h ../byterun/freelist.h \
+  ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \
+  ../byterun/minor_gc.h ../byterun/mlvalues.h ../byterun/stacks.h \
+  ../byterun/memory.h
 array.d.o: array.c ../byterun/alloc.h ../byterun/misc.h ../byterun/config.h \
- ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
- ../byterun/fail.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/misc.h ../byterun/mlvalues.h
+  ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
+  ../byterun/fail.h ../byterun/memory.h ../byterun/gc.h \
+  ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
+  ../byterun/misc.h ../byterun/mlvalues.h
 backtrace.d.o: backtrace.c ../byterun/alloc.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/mlvalues.h ../byterun/backtrace.h ../byterun/memory.h \
- ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/minor_gc.h ../byterun/misc.h ../byterun/mlvalues.h stack.h
+  ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
+  ../byterun/mlvalues.h ../byterun/backtrace.h ../byterun/memory.h \
+  ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \
+  ../byterun/minor_gc.h ../byterun/misc.h ../byterun/mlvalues.h stack.h
 callback.d.o: callback.c ../byterun/callback.h ../byterun/mlvalues.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/misc.h ../byterun/fail.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/mlvalues.h
+  ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
+  ../byterun/misc.h ../byterun/fail.h ../byterun/memory.h ../byterun/gc.h \
+  ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
+  ../byterun/mlvalues.h
 compact.d.o: compact.c ../byterun/config.h ../byterun/../config/m.h \
- ../byterun/../config/s.h ../byterun/finalise.h ../byterun/roots.h \
- ../byterun/misc.h ../byterun/config.h ../byterun/memory.h \
- ../byterun/gc.h ../byterun/mlvalues.h ../byterun/major_gc.h \
- ../byterun/freelist.h ../byterun/minor_gc.h ../byterun/freelist.h \
- ../byterun/gc.h ../byterun/gc_ctrl.h ../byterun/major_gc.h \
- ../byterun/memory.h ../byterun/mlvalues.h ../byterun/roots.h \
- ../byterun/weak.h
+  ../byterun/../config/s.h ../byterun/finalise.h ../byterun/roots.h \
+  ../byterun/misc.h ../byterun/config.h ../byterun/memory.h \
+  ../byterun/gc.h ../byterun/mlvalues.h ../byterun/major_gc.h \
+  ../byterun/freelist.h ../byterun/minor_gc.h ../byterun/freelist.h \
+  ../byterun/gc.h ../byterun/gc_ctrl.h ../byterun/major_gc.h \
+  ../byterun/memory.h ../byterun/mlvalues.h ../byterun/roots.h \
+  ../byterun/weak.h
 compare.d.o: compare.c ../byterun/custom.h ../byterun/mlvalues.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/misc.h ../byterun/fail.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/misc.h ../byterun/mlvalues.h
+  ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
+  ../byterun/misc.h ../byterun/fail.h ../byterun/memory.h ../byterun/gc.h \
+  ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
+  ../byterun/misc.h ../byterun/mlvalues.h
 custom.d.o: custom.c ../byterun/alloc.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/mlvalues.h ../byterun/custom.h ../byterun/fail.h \
- ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \
- ../byterun/freelist.h ../byterun/minor_gc.h ../byterun/mlvalues.h
+  ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
+  ../byterun/mlvalues.h ../byterun/custom.h ../byterun/fail.h \
+  ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \
+  ../byterun/freelist.h ../byterun/minor_gc.h ../byterun/mlvalues.h
 debugger.d.o: debugger.c ../byterun/alloc.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/mlvalues.h ../byterun/config.h ../byterun/debugger.h \
- ../byterun/misc.h
+  ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
+  ../byterun/mlvalues.h ../byterun/config.h ../byterun/debugger.h \
+  ../byterun/misc.h
 dynlink.d.o: dynlink.c ../byterun/config.h ../byterun/../config/m.h \
- ../byterun/../config/s.h ../byterun/alloc.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/mlvalues.h ../byterun/dynlink.h \
- ../byterun/fail.h ../byterun/mlvalues.h ../byterun/memory.h \
- ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/minor_gc.h ../byterun/misc.h ../byterun/osdeps.h \
- ../byterun/prims.h
+  ../byterun/../config/s.h ../byterun/alloc.h ../byterun/misc.h \
+  ../byterun/config.h ../byterun/mlvalues.h ../byterun/dynlink.h \
+  ../byterun/fail.h ../byterun/mlvalues.h ../byterun/memory.h \
+  ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \
+  ../byterun/minor_gc.h ../byterun/misc.h ../byterun/osdeps.h \
+  ../byterun/prims.h
 extern.d.o: extern.c ../byterun/alloc.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/mlvalues.h ../byterun/custom.h ../byterun/fail.h \
- ../byterun/gc.h ../byterun/intext.h ../byterun/io.h ../byterun/io.h \
- ../byterun/md5.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/misc.h ../byterun/mlvalues.h ../byterun/reverse.h
+  ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
+  ../byterun/mlvalues.h ../byterun/custom.h ../byterun/fail.h \
+  ../byterun/gc.h ../byterun/intext.h ../byterun/io.h ../byterun/io.h \
+  ../byterun/md5.h ../byterun/memory.h ../byterun/gc.h \
+  ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
+  ../byterun/misc.h ../byterun/mlvalues.h ../byterun/reverse.h
 fail.d.o: fail.c ../byterun/alloc.h ../byterun/misc.h ../byterun/config.h \
- ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
- ../byterun/fail.h ../byterun/io.h ../byterun/gc.h ../byterun/memory.h \
- ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/minor_gc.h ../byterun/mlvalues.h ../byterun/printexc.h \
- ../byterun/signals.h stack.h ../byterun/roots.h ../byterun/memory.h \
- ../byterun/callback.h
+  ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
+  ../byterun/fail.h ../byterun/io.h ../byterun/gc.h ../byterun/memory.h \
+  ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \
+  ../byterun/minor_gc.h ../byterun/mlvalues.h ../byterun/printexc.h \
+  ../byterun/signals.h stack.h ../byterun/roots.h ../byterun/memory.h \
+  ../byterun/callback.h
 finalise.d.o: finalise.c ../byterun/callback.h ../byterun/mlvalues.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/misc.h ../byterun/fail.h ../byterun/mlvalues.h \
- ../byterun/roots.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/signals.h
+  ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
+  ../byterun/misc.h ../byterun/fail.h ../byterun/mlvalues.h \
+  ../byterun/roots.h ../byterun/memory.h ../byterun/gc.h \
+  ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
+  ../byterun/signals.h
 floats.d.o: floats.c ../byterun/alloc.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/mlvalues.h ../byterun/fail.h ../byterun/memory.h \
- ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/minor_gc.h ../byterun/mlvalues.h ../byterun/misc.h \
- ../byterun/reverse.h ../byterun/stacks.h ../byterun/memory.h
+  ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
+  ../byterun/mlvalues.h ../byterun/fail.h ../byterun/memory.h \
+  ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \
+  ../byterun/minor_gc.h ../byterun/mlvalues.h ../byterun/misc.h \
+  ../byterun/reverse.h ../byterun/stacks.h ../byterun/memory.h
 freelist.d.o: freelist.c ../byterun/config.h ../byterun/../config/m.h \
- ../byterun/../config/s.h ../byterun/freelist.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/mlvalues.h ../byterun/gc.h \
- ../byterun/gc_ctrl.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/major_gc.h ../byterun/misc.h ../byterun/mlvalues.h
+  ../byterun/../config/s.h ../byterun/freelist.h ../byterun/misc.h \
+  ../byterun/config.h ../byterun/mlvalues.h ../byterun/gc.h \
+  ../byterun/gc_ctrl.h ../byterun/memory.h ../byterun/gc.h \
+  ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
+  ../byterun/major_gc.h ../byterun/misc.h ../byterun/mlvalues.h
 gc_ctrl.d.o: gc_ctrl.c ../byterun/alloc.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/mlvalues.h ../byterun/compact.h ../byterun/custom.h \
- ../byterun/finalise.h ../byterun/roots.h ../byterun/memory.h \
- ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/minor_gc.h ../byterun/freelist.h ../byterun/gc.h \
- ../byterun/gc_ctrl.h ../byterun/major_gc.h ../byterun/minor_gc.h \
- ../byterun/misc.h ../byterun/mlvalues.h stack.h
+  ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
+  ../byterun/mlvalues.h ../byterun/compact.h ../byterun/custom.h \
+  ../byterun/finalise.h ../byterun/roots.h ../byterun/memory.h \
+  ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \
+  ../byterun/minor_gc.h ../byterun/freelist.h ../byterun/gc.h \
+  ../byterun/gc_ctrl.h ../byterun/major_gc.h ../byterun/minor_gc.h \
+  ../byterun/misc.h ../byterun/mlvalues.h stack.h
 globroots.d.o: globroots.c ../byterun/memory.h ../byterun/config.h \
- ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/gc.h \
- ../byterun/mlvalues.h ../byterun/misc.h ../byterun/major_gc.h \
- ../byterun/freelist.h ../byterun/minor_gc.h ../byterun/misc.h \
- ../byterun/mlvalues.h ../byterun/roots.h ../byterun/memory.h \
- ../byterun/globroots.h ../byterun/roots.h
+  ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/gc.h \
+  ../byterun/mlvalues.h ../byterun/misc.h ../byterun/major_gc.h \
+  ../byterun/freelist.h ../byterun/minor_gc.h ../byterun/misc.h \
+  ../byterun/mlvalues.h ../byterun/roots.h ../byterun/memory.h \
+  ../byterun/globroots.h ../byterun/roots.h
 hash.d.o: hash.c ../byterun/mlvalues.h ../byterun/config.h \
- ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/misc.h \
- ../byterun/custom.h ../byterun/mlvalues.h ../byterun/memory.h \
- ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/minor_gc.h ../byterun/hash.h ../byterun/int64_native.h
+  ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/misc.h \
+  ../byterun/custom.h ../byterun/mlvalues.h ../byterun/memory.h \
+  ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \
+  ../byterun/minor_gc.h ../byterun/hash.h ../byterun/int64_native.h
 intern.d.o: intern.c ../byterun/alloc.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/mlvalues.h ../byterun/callback.h ../byterun/custom.h \
- ../byterun/fail.h ../byterun/gc.h ../byterun/intext.h ../byterun/io.h \
- ../byterun/io.h ../byterun/md5.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/mlvalues.h ../byterun/misc.h ../byterun/reverse.h
+  ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
+  ../byterun/mlvalues.h ../byterun/callback.h ../byterun/custom.h \
+  ../byterun/fail.h ../byterun/gc.h ../byterun/intext.h ../byterun/io.h \
+  ../byterun/io.h ../byterun/md5.h ../byterun/memory.h ../byterun/gc.h \
+  ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
+  ../byterun/mlvalues.h ../byterun/misc.h ../byterun/reverse.h
 ints.d.o: ints.c ../byterun/alloc.h ../byterun/misc.h ../byterun/config.h \
- ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
- ../byterun/custom.h ../byterun/fail.h ../byterun/intext.h \
- ../byterun/io.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/misc.h ../byterun/mlvalues.h ../byterun/int64_native.h
+  ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
+  ../byterun/custom.h ../byterun/fail.h ../byterun/intext.h \
+  ../byterun/io.h ../byterun/memory.h ../byterun/gc.h \
+  ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
+  ../byterun/misc.h ../byterun/mlvalues.h ../byterun/int64_native.h
 io.d.o: io.c ../byterun/config.h ../byterun/../config/m.h \
- ../byterun/../config/s.h ../byterun/alloc.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/mlvalues.h ../byterun/custom.h \
- ../byterun/fail.h ../byterun/io.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/misc.h ../byterun/mlvalues.h ../byterun/signals.h \
- ../byterun/sys.h
+  ../byterun/../config/s.h ../byterun/alloc.h ../byterun/misc.h \
+  ../byterun/config.h ../byterun/mlvalues.h ../byterun/custom.h \
+  ../byterun/fail.h ../byterun/io.h ../byterun/memory.h ../byterun/gc.h \
+  ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
+  ../byterun/misc.h ../byterun/mlvalues.h ../byterun/signals.h \
+  ../byterun/sys.h
 lexing.d.o: lexing.c ../byterun/fail.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/mlvalues.h ../byterun/mlvalues.h ../byterun/stacks.h \
- ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \
- ../byterun/freelist.h ../byterun/minor_gc.h
+  ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
+  ../byterun/mlvalues.h ../byterun/mlvalues.h ../byterun/stacks.h \
+  ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \
+  ../byterun/freelist.h ../byterun/minor_gc.h
 main.d.o: main.c ../byterun/misc.h ../byterun/config.h \
- ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
- ../byterun/misc.h ../byterun/sys.h
+  ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
+  ../byterun/misc.h ../byterun/sys.h
 major_gc.d.o: major_gc.c ../byterun/compact.h ../byterun/config.h \
- ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/misc.h \
- ../byterun/custom.h ../byterun/mlvalues.h ../byterun/config.h \
- ../byterun/fail.h ../byterun/finalise.h ../byterun/roots.h \
- ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \
- ../byterun/freelist.h ../byterun/minor_gc.h ../byterun/freelist.h \
- ../byterun/gc.h ../byterun/gc_ctrl.h ../byterun/major_gc.h \
- ../byterun/misc.h ../byterun/mlvalues.h ../byterun/roots.h \
- ../byterun/weak.h
+  ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/misc.h \
+  ../byterun/custom.h ../byterun/mlvalues.h ../byterun/config.h \
+  ../byterun/fail.h ../byterun/finalise.h ../byterun/roots.h \
+  ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \
+  ../byterun/freelist.h ../byterun/minor_gc.h ../byterun/freelist.h \
+  ../byterun/gc.h ../byterun/gc_ctrl.h ../byterun/major_gc.h \
+  ../byterun/misc.h ../byterun/mlvalues.h ../byterun/roots.h \
+  ../byterun/weak.h
 md5.d.o: md5.c ../byterun/alloc.h ../byterun/misc.h ../byterun/config.h \
- ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
- ../byterun/fail.h ../byterun/md5.h ../byterun/io.h ../byterun/memory.h \
- ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/minor_gc.h ../byterun/mlvalues.h ../byterun/io.h \
- ../byterun/reverse.h
+  ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
+  ../byterun/fail.h ../byterun/md5.h ../byterun/io.h ../byterun/memory.h \
+  ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \
+  ../byterun/minor_gc.h ../byterun/mlvalues.h ../byterun/io.h \
+  ../byterun/reverse.h
 memory.d.o: memory.c ../byterun/fail.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/mlvalues.h ../byterun/freelist.h ../byterun/gc.h \
- ../byterun/gc_ctrl.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \
- ../byterun/minor_gc.h ../byterun/minor_gc.h ../byterun/misc.h \
- ../byterun/mlvalues.h ../byterun/signals.h
+  ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
+  ../byterun/mlvalues.h ../byterun/freelist.h ../byterun/gc.h \
+  ../byterun/gc_ctrl.h ../byterun/major_gc.h ../byterun/freelist.h \
+  ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \
+  ../byterun/minor_gc.h ../byterun/minor_gc.h ../byterun/misc.h \
+  ../byterun/mlvalues.h ../byterun/signals.h
 meta.d.o: meta.c ../byterun/alloc.h ../byterun/misc.h ../byterun/config.h \
- ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
- ../byterun/config.h ../byterun/fail.h ../byterun/fix_code.h \
- ../byterun/interp.h ../byterun/intext.h ../byterun/io.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/memory.h \
- ../byterun/gc.h ../byterun/major_gc.h ../byterun/minor_gc.h \
- ../byterun/minor_gc.h ../byterun/misc.h ../byterun/mlvalues.h \
- ../byterun/prims.h ../byterun/stacks.h ../byterun/memory.h
+  ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
+  ../byterun/config.h ../byterun/fail.h ../byterun/fix_code.h \
+  ../byterun/interp.h ../byterun/intext.h ../byterun/io.h \
+  ../byterun/major_gc.h ../byterun/freelist.h ../byterun/memory.h \
+  ../byterun/gc.h ../byterun/major_gc.h ../byterun/minor_gc.h \
+  ../byterun/minor_gc.h ../byterun/misc.h ../byterun/mlvalues.h \
+  ../byterun/prims.h ../byterun/stacks.h ../byterun/memory.h
 minor_gc.d.o: minor_gc.c ../byterun/config.h ../byterun/../config/m.h \
- ../byterun/../config/s.h ../byterun/fail.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/mlvalues.h ../byterun/finalise.h \
- ../byterun/roots.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/gc.h ../byterun/gc_ctrl.h ../byterun/major_gc.h \
- ../byterun/memory.h ../byterun/minor_gc.h ../byterun/misc.h \
- ../byterun/mlvalues.h ../byterun/roots.h ../byterun/signals.h \
- ../byterun/weak.h
+  ../byterun/../config/s.h ../byterun/fail.h ../byterun/misc.h \
+  ../byterun/config.h ../byterun/mlvalues.h ../byterun/finalise.h \
+  ../byterun/roots.h ../byterun/memory.h ../byterun/gc.h \
+  ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
+  ../byterun/gc.h ../byterun/gc_ctrl.h ../byterun/major_gc.h \
+  ../byterun/memory.h ../byterun/minor_gc.h ../byterun/misc.h \
+  ../byterun/mlvalues.h ../byterun/roots.h ../byterun/signals.h \
+  ../byterun/weak.h
 misc.d.o: misc.c ../byterun/config.h ../byterun/../config/m.h \
- ../byterun/../config/s.h ../byterun/misc.h ../byterun/config.h \
- ../byterun/memory.h ../byterun/gc.h ../byterun/mlvalues.h \
- ../byterun/misc.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/minor_gc.h
+  ../byterun/../config/s.h ../byterun/misc.h ../byterun/config.h \
+  ../byterun/memory.h ../byterun/gc.h ../byterun/mlvalues.h \
+  ../byterun/misc.h ../byterun/major_gc.h ../byterun/freelist.h \
+  ../byterun/minor_gc.h
 natdynlink.d.o: natdynlink.c ../byterun/misc.h ../byterun/config.h \
- ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
- ../byterun/misc.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/mlvalues.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/minor_gc.h stack.h ../byterun/callback.h ../byterun/alloc.h \
- ../byterun/intext.h ../byterun/io.h ../byterun/osdeps.h \
- ../byterun/fail.h
+  ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
+  ../byterun/misc.h ../byterun/memory.h ../byterun/gc.h \
+  ../byterun/mlvalues.h ../byterun/major_gc.h ../byterun/freelist.h \
+  ../byterun/minor_gc.h stack.h ../byterun/callback.h ../byterun/alloc.h \
+  ../byterun/intext.h ../byterun/io.h ../byterun/osdeps.h \
+  ../byterun/fail.h
 obj.d.o: obj.c ../byterun/alloc.h ../byterun/misc.h ../byterun/config.h \
- ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
- ../byterun/fail.h ../byterun/gc.h ../byterun/interp.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/memory.h \
- ../byterun/gc.h ../byterun/major_gc.h ../byterun/minor_gc.h \
- ../byterun/minor_gc.h ../byterun/misc.h ../byterun/mlvalues.h \
- ../byterun/prims.h
+  ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
+  ../byterun/fail.h ../byterun/gc.h ../byterun/interp.h \
+  ../byterun/major_gc.h ../byterun/freelist.h ../byterun/memory.h \
+  ../byterun/gc.h ../byterun/major_gc.h ../byterun/minor_gc.h \
+  ../byterun/minor_gc.h ../byterun/misc.h ../byterun/mlvalues.h \
+  ../byterun/prims.h
 parsing.d.o: parsing.c ../byterun/config.h ../byterun/../config/m.h \
- ../byterun/../config/s.h ../byterun/mlvalues.h ../byterun/config.h \
- ../byterun/misc.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/mlvalues.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/minor_gc.h ../byterun/alloc.h
+  ../byterun/../config/s.h ../byterun/mlvalues.h ../byterun/config.h \
+  ../byterun/misc.h ../byterun/memory.h ../byterun/gc.h \
+  ../byterun/mlvalues.h ../byterun/major_gc.h ../byterun/freelist.h \
+  ../byterun/minor_gc.h ../byterun/alloc.h
 printexc.d.o: printexc.c ../byterun/backtrace.h ../byterun/mlvalues.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/misc.h ../byterun/callback.h ../byterun/debugger.h \
- ../byterun/fail.h ../byterun/misc.h ../byterun/mlvalues.h \
- ../byterun/printexc.h
+  ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
+  ../byterun/misc.h ../byterun/callback.h ../byterun/debugger.h \
+  ../byterun/fail.h ../byterun/misc.h ../byterun/mlvalues.h \
+  ../byterun/printexc.h
 roots.d.o: roots.c ../byterun/finalise.h ../byterun/roots.h \
- ../byterun/misc.h ../byterun/config.h ../byterun/../config/m.h \
- ../byterun/../config/s.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/mlvalues.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/minor_gc.h ../byterun/globroots.h ../byterun/memory.h \
- ../byterun/major_gc.h ../byterun/minor_gc.h ../byterun/misc.h \
- ../byterun/mlvalues.h stack.h ../byterun/roots.h
+  ../byterun/misc.h ../byterun/config.h ../byterun/../config/m.h \
+  ../byterun/../config/s.h ../byterun/memory.h ../byterun/gc.h \
+  ../byterun/mlvalues.h ../byterun/major_gc.h ../byterun/freelist.h \
+  ../byterun/minor_gc.h ../byterun/globroots.h ../byterun/memory.h \
+  ../byterun/major_gc.h ../byterun/minor_gc.h ../byterun/misc.h \
+  ../byterun/mlvalues.h stack.h ../byterun/roots.h
 signals.d.o: signals.c ../byterun/alloc.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/mlvalues.h ../byterun/callback.h ../byterun/config.h \
- ../byterun/fail.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/misc.h ../byterun/mlvalues.h ../byterun/roots.h \
- ../byterun/memory.h ../byterun/signals.h ../byterun/signals_machdep.h \
- ../byterun/sys.h
+  ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
+  ../byterun/mlvalues.h ../byterun/callback.h ../byterun/config.h \
+  ../byterun/fail.h ../byterun/memory.h ../byterun/gc.h \
+  ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
+  ../byterun/misc.h ../byterun/mlvalues.h ../byterun/roots.h \
+  ../byterun/memory.h ../byterun/signals.h ../byterun/signals_machdep.h \
+  ../byterun/sys.h
 signals_asm.d.o: signals_asm.c ../byterun/fail.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/mlvalues.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/osdeps.h ../byterun/signals.h ../byterun/signals_machdep.h \
- signals_osdep.h stack.h
+  ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
+  ../byterun/mlvalues.h ../byterun/memory.h ../byterun/gc.h \
+  ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
+  ../byterun/osdeps.h ../byterun/signals.h ../byterun/signals_machdep.h \
+  signals_osdep.h stack.h
 startup.d.o: startup.c ../byterun/callback.h ../byterun/mlvalues.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/misc.h ../byterun/backtrace.h ../byterun/custom.h \
- ../byterun/debugger.h ../byterun/fail.h ../byterun/freelist.h \
- ../byterun/gc.h ../byterun/gc_ctrl.h ../byterun/intext.h ../byterun/io.h \
- ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \
- ../byterun/freelist.h ../byterun/minor_gc.h ../byterun/misc.h \
- ../byterun/mlvalues.h ../byterun/osdeps.h ../byterun/printexc.h stack.h \
- ../byterun/sys.h
+  ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
+  ../byterun/misc.h ../byterun/backtrace.h ../byterun/custom.h \
+  ../byterun/debugger.h ../byterun/fail.h ../byterun/freelist.h \
+  ../byterun/gc.h ../byterun/gc_ctrl.h ../byterun/intext.h \
+  ../byterun/io.h ../byterun/memory.h ../byterun/gc.h \
+  ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
+  ../byterun/misc.h ../byterun/mlvalues.h ../byterun/osdeps.h \
+  ../byterun/printexc.h stack.h ../byterun/sys.h
 str.d.o: str.c ../byterun/alloc.h ../byterun/misc.h ../byterun/config.h \
- ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
- ../byterun/fail.h ../byterun/mlvalues.h ../byterun/misc.h \
- ../byterun/int64_native.h
+  ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
+  ../byterun/fail.h ../byterun/mlvalues.h ../byterun/misc.h \
+  ../byterun/int64_native.h
 sys.d.o: sys.c ../byterun/config.h ../byterun/../config/m.h \
- ../byterun/../config/s.h ../byterun/alloc.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/mlvalues.h ../byterun/debugger.h \
- ../byterun/fail.h ../byterun/instruct.h ../byterun/mlvalues.h \
- ../byterun/osdeps.h ../byterun/signals.h ../byterun/stacks.h \
- ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \
- ../byterun/freelist.h ../byterun/minor_gc.h ../byterun/sys.h
+  ../byterun/../config/s.h ../byterun/alloc.h ../byterun/misc.h \
+  ../byterun/config.h ../byterun/mlvalues.h ../byterun/debugger.h \
+  ../byterun/fail.h ../byterun/instruct.h ../byterun/mlvalues.h \
+  ../byterun/osdeps.h ../byterun/signals.h ../byterun/stacks.h \
+  ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \
+  ../byterun/freelist.h ../byterun/minor_gc.h ../byterun/sys.h
 terminfo.d.o: terminfo.c ../byterun/config.h ../byterun/../config/m.h \
- ../byterun/../config/s.h ../byterun/alloc.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/mlvalues.h ../byterun/fail.h \
- ../byterun/io.h ../byterun/mlvalues.h
+  ../byterun/../config/s.h ../byterun/alloc.h ../byterun/misc.h \
+  ../byterun/config.h ../byterun/mlvalues.h ../byterun/fail.h \
+  ../byterun/io.h ../byterun/mlvalues.h
 unix.d.o: unix.c ../byterun/config.h ../byterun/../config/m.h \
- ../byterun/../config/s.h ../byterun/memory.h ../byterun/config.h \
- ../byterun/gc.h ../byterun/mlvalues.h ../byterun/misc.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/misc.h ../byterun/osdeps.h
+  ../byterun/../config/s.h ../byterun/memory.h ../byterun/config.h \
+  ../byterun/gc.h ../byterun/mlvalues.h ../byterun/misc.h \
+  ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
+  ../byterun/misc.h ../byterun/osdeps.h
 weak.d.o: weak.c ../byterun/alloc.h ../byterun/misc.h ../byterun/config.h \
- ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
- ../byterun/fail.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \
- ../byterun/minor_gc.h ../byterun/mlvalues.h
+  ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
+  ../byterun/fail.h ../byterun/major_gc.h ../byterun/freelist.h \
+  ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \
+  ../byterun/minor_gc.h ../byterun/mlvalues.h
 alloc.p.o: alloc.c ../byterun/alloc.h ../byterun/misc.h ../byterun/config.h \
- ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
- ../byterun/custom.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \
- ../byterun/minor_gc.h ../byterun/mlvalues.h ../byterun/stacks.h \
- ../byterun/memory.h
+  ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
+  ../byterun/custom.h ../byterun/major_gc.h ../byterun/freelist.h \
+  ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \
+  ../byterun/minor_gc.h ../byterun/mlvalues.h ../byterun/stacks.h \
+  ../byterun/memory.h
 array.p.o: array.c ../byterun/alloc.h ../byterun/misc.h ../byterun/config.h \
- ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
- ../byterun/fail.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/misc.h ../byterun/mlvalues.h
+  ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
+  ../byterun/fail.h ../byterun/memory.h ../byterun/gc.h \
+  ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
+  ../byterun/misc.h ../byterun/mlvalues.h
 backtrace.p.o: backtrace.c ../byterun/alloc.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/mlvalues.h ../byterun/backtrace.h ../byterun/memory.h \
- ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/minor_gc.h ../byterun/misc.h ../byterun/mlvalues.h stack.h
+  ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
+  ../byterun/mlvalues.h ../byterun/backtrace.h ../byterun/memory.h \
+  ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \
+  ../byterun/minor_gc.h ../byterun/misc.h ../byterun/mlvalues.h stack.h
 callback.p.o: callback.c ../byterun/callback.h ../byterun/mlvalues.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/misc.h ../byterun/fail.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/mlvalues.h
+  ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
+  ../byterun/misc.h ../byterun/fail.h ../byterun/memory.h ../byterun/gc.h \
+  ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
+  ../byterun/mlvalues.h
 compact.p.o: compact.c ../byterun/config.h ../byterun/../config/m.h \
- ../byterun/../config/s.h ../byterun/finalise.h ../byterun/roots.h \
- ../byterun/misc.h ../byterun/config.h ../byterun/memory.h \
- ../byterun/gc.h ../byterun/mlvalues.h ../byterun/major_gc.h \
- ../byterun/freelist.h ../byterun/minor_gc.h ../byterun/freelist.h \
- ../byterun/gc.h ../byterun/gc_ctrl.h ../byterun/major_gc.h \
- ../byterun/memory.h ../byterun/mlvalues.h ../byterun/roots.h \
- ../byterun/weak.h
+  ../byterun/../config/s.h ../byterun/finalise.h ../byterun/roots.h \
+  ../byterun/misc.h ../byterun/config.h ../byterun/memory.h \
+  ../byterun/gc.h ../byterun/mlvalues.h ../byterun/major_gc.h \
+  ../byterun/freelist.h ../byterun/minor_gc.h ../byterun/freelist.h \
+  ../byterun/gc.h ../byterun/gc_ctrl.h ../byterun/major_gc.h \
+  ../byterun/memory.h ../byterun/mlvalues.h ../byterun/roots.h \
+  ../byterun/weak.h
 compare.p.o: compare.c ../byterun/custom.h ../byterun/mlvalues.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/misc.h ../byterun/fail.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/misc.h ../byterun/mlvalues.h
+  ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
+  ../byterun/misc.h ../byterun/fail.h ../byterun/memory.h ../byterun/gc.h \
+  ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
+  ../byterun/misc.h ../byterun/mlvalues.h
 custom.p.o: custom.c ../byterun/alloc.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/mlvalues.h ../byterun/custom.h ../byterun/fail.h \
- ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \
- ../byterun/freelist.h ../byterun/minor_gc.h ../byterun/mlvalues.h
+  ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
+  ../byterun/mlvalues.h ../byterun/custom.h ../byterun/fail.h \
+  ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \
+  ../byterun/freelist.h ../byterun/minor_gc.h ../byterun/mlvalues.h
 debugger.p.o: debugger.c ../byterun/alloc.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/mlvalues.h ../byterun/config.h ../byterun/debugger.h \
- ../byterun/misc.h
+  ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
+  ../byterun/mlvalues.h ../byterun/config.h ../byterun/debugger.h \
+  ../byterun/misc.h
 dynlink.p.o: dynlink.c ../byterun/config.h ../byterun/../config/m.h \
- ../byterun/../config/s.h ../byterun/alloc.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/mlvalues.h ../byterun/dynlink.h \
- ../byterun/fail.h ../byterun/mlvalues.h ../byterun/memory.h \
- ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/minor_gc.h ../byterun/misc.h ../byterun/osdeps.h \
- ../byterun/prims.h
+  ../byterun/../config/s.h ../byterun/alloc.h ../byterun/misc.h \
+  ../byterun/config.h ../byterun/mlvalues.h ../byterun/dynlink.h \
+  ../byterun/fail.h ../byterun/mlvalues.h ../byterun/memory.h \
+  ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \
+  ../byterun/minor_gc.h ../byterun/misc.h ../byterun/osdeps.h \
+  ../byterun/prims.h
 extern.p.o: extern.c ../byterun/alloc.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/mlvalues.h ../byterun/custom.h ../byterun/fail.h \
- ../byterun/gc.h ../byterun/intext.h ../byterun/io.h ../byterun/io.h \
- ../byterun/md5.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/misc.h ../byterun/mlvalues.h ../byterun/reverse.h
+  ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
+  ../byterun/mlvalues.h ../byterun/custom.h ../byterun/fail.h \
+  ../byterun/gc.h ../byterun/intext.h ../byterun/io.h ../byterun/io.h \
+  ../byterun/md5.h ../byterun/memory.h ../byterun/gc.h \
+  ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
+  ../byterun/misc.h ../byterun/mlvalues.h ../byterun/reverse.h
 fail.p.o: fail.c ../byterun/alloc.h ../byterun/misc.h ../byterun/config.h \
- ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
- ../byterun/fail.h ../byterun/io.h ../byterun/gc.h ../byterun/memory.h \
- ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/minor_gc.h ../byterun/mlvalues.h ../byterun/printexc.h \
- ../byterun/signals.h stack.h ../byterun/roots.h ../byterun/memory.h \
- ../byterun/callback.h
+  ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
+  ../byterun/fail.h ../byterun/io.h ../byterun/gc.h ../byterun/memory.h \
+  ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \
+  ../byterun/minor_gc.h ../byterun/mlvalues.h ../byterun/printexc.h \
+  ../byterun/signals.h stack.h ../byterun/roots.h ../byterun/memory.h \
+  ../byterun/callback.h
 finalise.p.o: finalise.c ../byterun/callback.h ../byterun/mlvalues.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/misc.h ../byterun/fail.h ../byterun/mlvalues.h \
- ../byterun/roots.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/signals.h
+  ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
+  ../byterun/misc.h ../byterun/fail.h ../byterun/mlvalues.h \
+  ../byterun/roots.h ../byterun/memory.h ../byterun/gc.h \
+  ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
+  ../byterun/signals.h
 floats.p.o: floats.c ../byterun/alloc.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/mlvalues.h ../byterun/fail.h ../byterun/memory.h \
- ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/minor_gc.h ../byterun/mlvalues.h ../byterun/misc.h \
- ../byterun/reverse.h ../byterun/stacks.h ../byterun/memory.h
+  ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
+  ../byterun/mlvalues.h ../byterun/fail.h ../byterun/memory.h \
+  ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \
+  ../byterun/minor_gc.h ../byterun/mlvalues.h ../byterun/misc.h \
+  ../byterun/reverse.h ../byterun/stacks.h ../byterun/memory.h
 freelist.p.o: freelist.c ../byterun/config.h ../byterun/../config/m.h \
- ../byterun/../config/s.h ../byterun/freelist.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/mlvalues.h ../byterun/gc.h \
- ../byterun/gc_ctrl.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/major_gc.h ../byterun/misc.h ../byterun/mlvalues.h
+  ../byterun/../config/s.h ../byterun/freelist.h ../byterun/misc.h \
+  ../byterun/config.h ../byterun/mlvalues.h ../byterun/gc.h \
+  ../byterun/gc_ctrl.h ../byterun/memory.h ../byterun/gc.h \
+  ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
+  ../byterun/major_gc.h ../byterun/misc.h ../byterun/mlvalues.h
 gc_ctrl.p.o: gc_ctrl.c ../byterun/alloc.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/mlvalues.h ../byterun/compact.h ../byterun/custom.h \
- ../byterun/finalise.h ../byterun/roots.h ../byterun/memory.h \
- ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/minor_gc.h ../byterun/freelist.h ../byterun/gc.h \
- ../byterun/gc_ctrl.h ../byterun/major_gc.h ../byterun/minor_gc.h \
- ../byterun/misc.h ../byterun/mlvalues.h stack.h
+  ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
+  ../byterun/mlvalues.h ../byterun/compact.h ../byterun/custom.h \
+  ../byterun/finalise.h ../byterun/roots.h ../byterun/memory.h \
+  ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \
+  ../byterun/minor_gc.h ../byterun/freelist.h ../byterun/gc.h \
+  ../byterun/gc_ctrl.h ../byterun/major_gc.h ../byterun/minor_gc.h \
+  ../byterun/misc.h ../byterun/mlvalues.h stack.h
 globroots.p.o: globroots.c ../byterun/memory.h ../byterun/config.h \
- ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/gc.h \
- ../byterun/mlvalues.h ../byterun/misc.h ../byterun/major_gc.h \
- ../byterun/freelist.h ../byterun/minor_gc.h ../byterun/misc.h \
- ../byterun/mlvalues.h ../byterun/roots.h ../byterun/memory.h \
- ../byterun/globroots.h ../byterun/roots.h
+  ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/gc.h \
+  ../byterun/mlvalues.h ../byterun/misc.h ../byterun/major_gc.h \
+  ../byterun/freelist.h ../byterun/minor_gc.h ../byterun/misc.h \
+  ../byterun/mlvalues.h ../byterun/roots.h ../byterun/memory.h \
+  ../byterun/globroots.h ../byterun/roots.h
 hash.p.o: hash.c ../byterun/mlvalues.h ../byterun/config.h \
- ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/misc.h \
- ../byterun/custom.h ../byterun/mlvalues.h ../byterun/memory.h \
- ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/minor_gc.h ../byterun/hash.h ../byterun/int64_native.h
+  ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/misc.h \
+  ../byterun/custom.h ../byterun/mlvalues.h ../byterun/memory.h \
+  ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \
+  ../byterun/minor_gc.h ../byterun/hash.h ../byterun/int64_native.h
 intern.p.o: intern.c ../byterun/alloc.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/mlvalues.h ../byterun/callback.h ../byterun/custom.h \
- ../byterun/fail.h ../byterun/gc.h ../byterun/intext.h ../byterun/io.h \
- ../byterun/io.h ../byterun/md5.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/mlvalues.h ../byterun/misc.h ../byterun/reverse.h
+  ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
+  ../byterun/mlvalues.h ../byterun/callback.h ../byterun/custom.h \
+  ../byterun/fail.h ../byterun/gc.h ../byterun/intext.h ../byterun/io.h \
+  ../byterun/io.h ../byterun/md5.h ../byterun/memory.h ../byterun/gc.h \
+  ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
+  ../byterun/mlvalues.h ../byterun/misc.h ../byterun/reverse.h
 ints.p.o: ints.c ../byterun/alloc.h ../byterun/misc.h ../byterun/config.h \
- ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
- ../byterun/custom.h ../byterun/fail.h ../byterun/intext.h \
- ../byterun/io.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/misc.h ../byterun/mlvalues.h ../byterun/int64_native.h
+  ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
+  ../byterun/custom.h ../byterun/fail.h ../byterun/intext.h \
+  ../byterun/io.h ../byterun/memory.h ../byterun/gc.h \
+  ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
+  ../byterun/misc.h ../byterun/mlvalues.h ../byterun/int64_native.h
 io.p.o: io.c ../byterun/config.h ../byterun/../config/m.h \
- ../byterun/../config/s.h ../byterun/alloc.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/mlvalues.h ../byterun/custom.h \
- ../byterun/fail.h ../byterun/io.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/misc.h ../byterun/mlvalues.h ../byterun/signals.h \
- ../byterun/sys.h
+  ../byterun/../config/s.h ../byterun/alloc.h ../byterun/misc.h \
+  ../byterun/config.h ../byterun/mlvalues.h ../byterun/custom.h \
+  ../byterun/fail.h ../byterun/io.h ../byterun/memory.h ../byterun/gc.h \
+  ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
+  ../byterun/misc.h ../byterun/mlvalues.h ../byterun/signals.h \
+  ../byterun/sys.h
 lexing.p.o: lexing.c ../byterun/fail.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/mlvalues.h ../byterun/mlvalues.h ../byterun/stacks.h \
- ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \
- ../byterun/freelist.h ../byterun/minor_gc.h
+  ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
+  ../byterun/mlvalues.h ../byterun/mlvalues.h ../byterun/stacks.h \
+  ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \
+  ../byterun/freelist.h ../byterun/minor_gc.h
 main.p.o: main.c ../byterun/misc.h ../byterun/config.h \
- ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
- ../byterun/misc.h ../byterun/sys.h
+  ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
+  ../byterun/misc.h ../byterun/sys.h
 major_gc.p.o: major_gc.c ../byterun/compact.h ../byterun/config.h \
- ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/misc.h \
- ../byterun/custom.h ../byterun/mlvalues.h ../byterun/config.h \
- ../byterun/fail.h ../byterun/finalise.h ../byterun/roots.h \
- ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \
- ../byterun/freelist.h ../byterun/minor_gc.h ../byterun/freelist.h \
- ../byterun/gc.h ../byterun/gc_ctrl.h ../byterun/major_gc.h \
- ../byterun/misc.h ../byterun/mlvalues.h ../byterun/roots.h \
- ../byterun/weak.h
+  ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/misc.h \
+  ../byterun/custom.h ../byterun/mlvalues.h ../byterun/config.h \
+  ../byterun/fail.h ../byterun/finalise.h ../byterun/roots.h \
+  ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \
+  ../byterun/freelist.h ../byterun/minor_gc.h ../byterun/freelist.h \
+  ../byterun/gc.h ../byterun/gc_ctrl.h ../byterun/major_gc.h \
+  ../byterun/misc.h ../byterun/mlvalues.h ../byterun/roots.h \
+  ../byterun/weak.h
 md5.p.o: md5.c ../byterun/alloc.h ../byterun/misc.h ../byterun/config.h \
- ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
- ../byterun/fail.h ../byterun/md5.h ../byterun/io.h ../byterun/memory.h \
- ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/minor_gc.h ../byterun/mlvalues.h ../byterun/io.h \
- ../byterun/reverse.h
+  ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
+  ../byterun/fail.h ../byterun/md5.h ../byterun/io.h ../byterun/memory.h \
+  ../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \
+  ../byterun/minor_gc.h ../byterun/mlvalues.h ../byterun/io.h \
+  ../byterun/reverse.h
 memory.p.o: memory.c ../byterun/fail.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/mlvalues.h ../byterun/freelist.h ../byterun/gc.h \
- ../byterun/gc_ctrl.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \
- ../byterun/minor_gc.h ../byterun/minor_gc.h ../byterun/misc.h \
- ../byterun/mlvalues.h ../byterun/signals.h
+  ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
+  ../byterun/mlvalues.h ../byterun/freelist.h ../byterun/gc.h \
+  ../byterun/gc_ctrl.h ../byterun/major_gc.h ../byterun/freelist.h \
+  ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \
+  ../byterun/minor_gc.h ../byterun/minor_gc.h ../byterun/misc.h \
+  ../byterun/mlvalues.h ../byterun/signals.h
 meta.p.o: meta.c ../byterun/alloc.h ../byterun/misc.h ../byterun/config.h \
- ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
- ../byterun/config.h ../byterun/fail.h ../byterun/fix_code.h \
- ../byterun/interp.h ../byterun/intext.h ../byterun/io.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/memory.h \
- ../byterun/gc.h ../byterun/major_gc.h ../byterun/minor_gc.h \
- ../byterun/minor_gc.h ../byterun/misc.h ../byterun/mlvalues.h \
- ../byterun/prims.h ../byterun/stacks.h ../byterun/memory.h
+  ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
+  ../byterun/config.h ../byterun/fail.h ../byterun/fix_code.h \
+  ../byterun/interp.h ../byterun/intext.h ../byterun/io.h \
+  ../byterun/major_gc.h ../byterun/freelist.h ../byterun/memory.h \
+  ../byterun/gc.h ../byterun/major_gc.h ../byterun/minor_gc.h \
+  ../byterun/minor_gc.h ../byterun/misc.h ../byterun/mlvalues.h \
+  ../byterun/prims.h ../byterun/stacks.h ../byterun/memory.h
 minor_gc.p.o: minor_gc.c ../byterun/config.h ../byterun/../config/m.h \
- ../byterun/../config/s.h ../byterun/fail.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/mlvalues.h ../byterun/finalise.h \
- ../byterun/roots.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/gc.h ../byterun/gc_ctrl.h ../byterun/major_gc.h \
- ../byterun/memory.h ../byterun/minor_gc.h ../byterun/misc.h \
- ../byterun/mlvalues.h ../byterun/roots.h ../byterun/signals.h \
- ../byterun/weak.h
+  ../byterun/../config/s.h ../byterun/fail.h ../byterun/misc.h \
+  ../byterun/config.h ../byterun/mlvalues.h ../byterun/finalise.h \
+  ../byterun/roots.h ../byterun/memory.h ../byterun/gc.h \
+  ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
+  ../byterun/gc.h ../byterun/gc_ctrl.h ../byterun/major_gc.h \
+  ../byterun/memory.h ../byterun/minor_gc.h ../byterun/misc.h \
+  ../byterun/mlvalues.h ../byterun/roots.h ../byterun/signals.h \
+  ../byterun/weak.h
 misc.p.o: misc.c ../byterun/config.h ../byterun/../config/m.h \
- ../byterun/../config/s.h ../byterun/misc.h ../byterun/config.h \
- ../byterun/memory.h ../byterun/gc.h ../byterun/mlvalues.h \
- ../byterun/misc.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/minor_gc.h
+  ../byterun/../config/s.h ../byterun/misc.h ../byterun/config.h \
+  ../byterun/memory.h ../byterun/gc.h ../byterun/mlvalues.h \
+  ../byterun/misc.h ../byterun/major_gc.h ../byterun/freelist.h \
+  ../byterun/minor_gc.h
 natdynlink.p.o: natdynlink.c ../byterun/misc.h ../byterun/config.h \
- ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
- ../byterun/misc.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/mlvalues.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/minor_gc.h stack.h ../byterun/callback.h ../byterun/alloc.h \
- ../byterun/intext.h ../byterun/io.h ../byterun/osdeps.h \
- ../byterun/fail.h
+  ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
+  ../byterun/misc.h ../byterun/memory.h ../byterun/gc.h \
+  ../byterun/mlvalues.h ../byterun/major_gc.h ../byterun/freelist.h \
+  ../byterun/minor_gc.h stack.h ../byterun/callback.h ../byterun/alloc.h \
+  ../byterun/intext.h ../byterun/io.h ../byterun/osdeps.h \
+  ../byterun/fail.h
 obj.p.o: obj.c ../byterun/alloc.h ../byterun/misc.h ../byterun/config.h \
- ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
- ../byterun/fail.h ../byterun/gc.h ../byterun/interp.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/memory.h \
- ../byterun/gc.h ../byterun/major_gc.h ../byterun/minor_gc.h \
- ../byterun/minor_gc.h ../byterun/misc.h ../byterun/mlvalues.h \
- ../byterun/prims.h
+  ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
+  ../byterun/fail.h ../byterun/gc.h ../byterun/interp.h \
+  ../byterun/major_gc.h ../byterun/freelist.h ../byterun/memory.h \
+  ../byterun/gc.h ../byterun/major_gc.h ../byterun/minor_gc.h \
+  ../byterun/minor_gc.h ../byterun/misc.h ../byterun/mlvalues.h \
+  ../byterun/prims.h
 parsing.p.o: parsing.c ../byterun/config.h ../byterun/../config/m.h \
- ../byterun/../config/s.h ../byterun/mlvalues.h ../byterun/config.h \
- ../byterun/misc.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/mlvalues.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/minor_gc.h ../byterun/alloc.h
+  ../byterun/../config/s.h ../byterun/mlvalues.h ../byterun/config.h \
+  ../byterun/misc.h ../byterun/memory.h ../byterun/gc.h \
+  ../byterun/mlvalues.h ../byterun/major_gc.h ../byterun/freelist.h \
+  ../byterun/minor_gc.h ../byterun/alloc.h
 printexc.p.o: printexc.c ../byterun/backtrace.h ../byterun/mlvalues.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/misc.h ../byterun/callback.h ../byterun/debugger.h \
- ../byterun/fail.h ../byterun/misc.h ../byterun/mlvalues.h \
- ../byterun/printexc.h
+  ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
+  ../byterun/misc.h ../byterun/callback.h ../byterun/debugger.h \
+  ../byterun/fail.h ../byterun/misc.h ../byterun/mlvalues.h \
+  ../byterun/printexc.h
 roots.p.o: roots.c ../byterun/finalise.h ../byterun/roots.h \
- ../byterun/misc.h ../byterun/config.h ../byterun/../config/m.h \
- ../byterun/../config/s.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/mlvalues.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/minor_gc.h ../byterun/globroots.h ../byterun/memory.h \
- ../byterun/major_gc.h ../byterun/minor_gc.h ../byterun/misc.h \
- ../byterun/mlvalues.h stack.h ../byterun/roots.h
+  ../byterun/misc.h ../byterun/config.h ../byterun/../config/m.h \
+  ../byterun/../config/s.h ../byterun/memory.h ../byterun/gc.h \
+  ../byterun/mlvalues.h ../byterun/major_gc.h ../byterun/freelist.h \
+  ../byterun/minor_gc.h ../byterun/globroots.h ../byterun/memory.h \
+  ../byterun/major_gc.h ../byterun/minor_gc.h ../byterun/misc.h \
+  ../byterun/mlvalues.h stack.h ../byterun/roots.h
 signals.p.o: signals.c ../byterun/alloc.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/mlvalues.h ../byterun/callback.h ../byterun/config.h \
- ../byterun/fail.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/misc.h ../byterun/mlvalues.h ../byterun/roots.h \
- ../byterun/memory.h ../byterun/signals.h ../byterun/signals_machdep.h \
- ../byterun/sys.h
+  ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
+  ../byterun/mlvalues.h ../byterun/callback.h ../byterun/config.h \
+  ../byterun/fail.h ../byterun/memory.h ../byterun/gc.h \
+  ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
+  ../byterun/misc.h ../byterun/mlvalues.h ../byterun/roots.h \
+  ../byterun/memory.h ../byterun/signals.h ../byterun/signals_machdep.h \
+  ../byterun/sys.h
 signals_asm.p.o: signals_asm.c ../byterun/fail.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/mlvalues.h ../byterun/memory.h ../byterun/gc.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/osdeps.h ../byterun/signals.h ../byterun/signals_machdep.h \
- signals_osdep.h stack.h
+  ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
+  ../byterun/mlvalues.h ../byterun/memory.h ../byterun/gc.h \
+  ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
+  ../byterun/osdeps.h ../byterun/signals.h ../byterun/signals_machdep.h \
+  signals_osdep.h stack.h
 startup.p.o: startup.c ../byterun/callback.h ../byterun/mlvalues.h \
- ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/misc.h ../byterun/backtrace.h ../byterun/custom.h \
- ../byterun/debugger.h ../byterun/fail.h ../byterun/freelist.h \
- ../byterun/gc.h ../byterun/gc_ctrl.h ../byterun/intext.h ../byterun/io.h \
- ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \
- ../byterun/freelist.h ../byterun/minor_gc.h ../byterun/misc.h \
- ../byterun/mlvalues.h ../byterun/osdeps.h ../byterun/printexc.h stack.h \
- ../byterun/sys.h
+  ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
+  ../byterun/misc.h ../byterun/backtrace.h ../byterun/custom.h \
+  ../byterun/debugger.h ../byterun/fail.h ../byterun/freelist.h \
+  ../byterun/gc.h ../byterun/gc_ctrl.h ../byterun/intext.h \
+  ../byterun/io.h ../byterun/memory.h ../byterun/gc.h \
+  ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
+  ../byterun/misc.h ../byterun/mlvalues.h ../byterun/osdeps.h \
+  ../byterun/printexc.h stack.h ../byterun/sys.h
 str.p.o: str.c ../byterun/alloc.h ../byterun/misc.h ../byterun/config.h \
- ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
- ../byterun/fail.h ../byterun/mlvalues.h ../byterun/misc.h \
- ../byterun/int64_native.h
+  ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
+  ../byterun/fail.h ../byterun/mlvalues.h ../byterun/misc.h \
+  ../byterun/int64_native.h
 sys.p.o: sys.c ../byterun/config.h ../byterun/../config/m.h \
- ../byterun/../config/s.h ../byterun/alloc.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/mlvalues.h ../byterun/debugger.h \
- ../byterun/fail.h ../byterun/instruct.h ../byterun/mlvalues.h \
- ../byterun/osdeps.h ../byterun/signals.h ../byterun/stacks.h \
- ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \
- ../byterun/freelist.h ../byterun/minor_gc.h ../byterun/sys.h
+  ../byterun/../config/s.h ../byterun/alloc.h ../byterun/misc.h \
+  ../byterun/config.h ../byterun/mlvalues.h ../byterun/debugger.h \
+  ../byterun/fail.h ../byterun/instruct.h ../byterun/mlvalues.h \
+  ../byterun/osdeps.h ../byterun/signals.h ../byterun/stacks.h \
+  ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \
+  ../byterun/freelist.h ../byterun/minor_gc.h ../byterun/sys.h
 terminfo.p.o: terminfo.c ../byterun/config.h ../byterun/../config/m.h \
- ../byterun/../config/s.h ../byterun/alloc.h ../byterun/misc.h \
- ../byterun/config.h ../byterun/mlvalues.h ../byterun/fail.h \
- ../byterun/io.h ../byterun/mlvalues.h
+  ../byterun/../config/s.h ../byterun/alloc.h ../byterun/misc.h \
+  ../byterun/config.h ../byterun/mlvalues.h ../byterun/fail.h \
+  ../byterun/io.h ../byterun/mlvalues.h
 unix.p.o: unix.c ../byterun/config.h ../byterun/../config/m.h \
- ../byterun/../config/s.h ../byterun/memory.h ../byterun/config.h \
- ../byterun/gc.h ../byterun/mlvalues.h ../byterun/misc.h \
- ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/misc.h ../byterun/osdeps.h
+  ../byterun/../config/s.h ../byterun/memory.h ../byterun/config.h \
+  ../byterun/gc.h ../byterun/mlvalues.h ../byterun/misc.h \
+  ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
+  ../byterun/misc.h ../byterun/osdeps.h
 weak.p.o: weak.c ../byterun/alloc.h ../byterun/misc.h ../byterun/config.h \
- ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
- ../byterun/fail.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \
- ../byterun/minor_gc.h ../byterun/mlvalues.h
+  ../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
+  ../byterun/fail.h ../byterun/major_gc.h ../byterun/freelist.h \
+  ../byterun/memory.h ../byterun/gc.h ../byterun/major_gc.h \
+  ../byterun/minor_gc.h ../byterun/mlvalues.h
diff --git a/asmrun/Makefile b/asmrun/Makefile
index 6c6dd98a8e..63ff80c687 100644
--- a/asmrun/Makefile
+++ b/asmrun/Makefile
@@ -183,7 +183,7 @@ clean::
           exit 2; }
 
 .S.p.o:
-	$(ASPP) -DSYS_$(SYSTEM) $(ASPPPROFFLAGS) -o $*.p.o $*.S
+	$(ASPP) -DSYS_$(SYSTEM) -DMODEL_$(MODEL) $(ASPPPROFFLAGS) -o $*.p.o $*.S
 
 .c.d.o:
 	ln -s -f $*.c $*.d.c
diff --git a/asmrun/arm64.S b/asmrun/arm64.S
index 2c16a0eadb..fa871df797 100644
--- a/asmrun/arm64.S
+++ b/asmrun/arm64.S
@@ -478,7 +478,7 @@ caml_callback2_exn:
     /* Initial shuffling of arguments (x0 = closure, x1 = arg1, x2 = arg2) */
         mov     TMP, x0
         mov     x0, x1          /* x0 = first arg */
-        mov     x1, x2          /* x1 = second arg
+        mov     x1, x2          /* x1 = second arg */
         mov     x2, TMP         /* x2 = closure environment */
         ADDRGLOBAL(ARG, caml_apply2)
         b       .Ljump_to_caml
diff --git a/asmrun/backtrace.c b/asmrun/backtrace.c
index 3854967cf4..c72a2373b9 100644
--- a/asmrun/backtrace.c
+++ b/asmrun/backtrace.c
@@ -30,6 +30,17 @@ code_t * caml_backtrace_buffer = NULL;
 value caml_backtrace_last_exn = Val_unit;
 #define BACKTRACE_BUFFER_SIZE 1024
 
+/* In order to prevent the GC from walking through the debug information
+   (which have no headers), we transform frame_descr pointers into
+   31/63 bits ocaml integers by shifting them by 1 to the right. We do
+   not lose information as descr pointers are aligned.
+
+   In particular, we do not need to use [caml_initialize] when setting
+   an array element with such a value.
+*/
+#define Val_Descrptr(descr) Val_long((uintnat)descr>>1)
+#define Descrptr_Val(v) ((frame_descr *) (Long_val(v)<<1))
+
 /* Start or stop the backtrace machinery */
 
 CAMLprim value caml_record_backtrace(value vflag)
@@ -112,6 +123,7 @@ void caml_stash_backtrace(value exn, uintnat pc, char * sp, char * trapsp)
     caml_backtrace_last_exn = exn;
   }
   if (caml_backtrace_buffer == NULL) {
+    Assert(caml_backtrace_pos == 0);
     caml_backtrace_buffer = malloc(BACKTRACE_BUFFER_SIZE * sizeof(code_t));
     if (caml_backtrace_buffer == NULL) return;
   }
@@ -172,7 +184,7 @@ CAMLprim value caml_get_current_callstack(value max_frames_value) {
     }
   }
 
-  trace = caml_alloc((mlsize_t) trace_size, Abstract_tag);
+  trace = caml_alloc((mlsize_t) trace_size, 0);
 
   /* then collect the trace */
   {
@@ -183,11 +195,7 @@ CAMLprim value caml_get_current_callstack(value max_frames_value) {
     for (trace_pos = 0; trace_pos < trace_size; trace_pos++) {
       frame_descr * descr = caml_next_frame_descriptor(&pc, &sp);
       Assert(descr != NULL);
-      /* The assignment below is safe without [caml_initialize], even
-         if the trace is large and allocated on the old heap, because
-         we assign values that are outside the OCaml heap. */
-      Assert(!(Is_block((value) descr) && Is_in_heap((value) descr)));
-      Field(trace, trace_pos) = (value) descr;
+      Field(trace, trace_pos) = Val_Descrptr(descr);
     }
   }
 
@@ -295,31 +303,27 @@ void caml_print_exception_backtrace(void)
 
 /* Convert the raw backtrace to a data structure usable from OCaml */
 
-CAMLprim value caml_convert_raw_backtrace(value backtrace) {
-  CAMLparam1(backtrace);
-  CAMLlocal4(res, arr, p, fname);
-  int i;
+CAMLprim value caml_convert_raw_backtrace_slot(value backtrace_slot) {
+  CAMLparam1(backtrace_slot);
+  CAMLlocal2(p, fname);
   struct loc_info li;
 
-  arr = caml_alloc(Wosize_val(backtrace), 0);
-  for (i = 0; i < Wosize_val(backtrace); i++) {
-    extract_location_info((frame_descr *) Field(backtrace, i), &li);
-    if (li.loc_valid) {
-      fname = caml_copy_string(li.loc_filename);
-      p = caml_alloc_small(5, 0);
-      Field(p, 0) = Val_bool(li.loc_is_raise);
-      Field(p, 1) = fname;
-      Field(p, 2) = Val_int(li.loc_lnum);
-      Field(p, 3) = Val_int(li.loc_startchr);
-      Field(p, 4) = Val_int(li.loc_endchr);
-    } else {
-      p = caml_alloc_small(1, 1);
-      Field(p, 0) = Val_bool(li.loc_is_raise);
-    }
-    caml_modify(&Field(arr, i), p);
+  extract_location_info(Descrptr_Val(backtrace_slot), &li);
+
+  if (li.loc_valid) {
+    fname = caml_copy_string(li.loc_filename);
+    p = caml_alloc_small(5, 0);
+    Field(p, 0) = Val_bool(li.loc_is_raise);
+    Field(p, 1) = fname;
+    Field(p, 2) = Val_int(li.loc_lnum);
+    Field(p, 3) = Val_int(li.loc_startchr);
+    Field(p, 4) = Val_int(li.loc_endchr);
+  } else {
+    p = caml_alloc_small(1, 1);
+    Field(p, 0) = Val_bool(li.loc_is_raise);
   }
-  res = caml_alloc_small(1, 0); Field(res, 0) = arr; /* Some */
-  CAMLreturn(res);
+
+  CAMLreturn(p);
 }
 
 /* Get a copy of the latest backtrace */
@@ -328,10 +332,13 @@ CAMLprim value caml_get_exception_raw_backtrace(value unit)
 {
   CAMLparam0();
   CAMLlocal1(res);
-  res = caml_alloc(caml_backtrace_pos, Abstract_tag);
-  if(caml_backtrace_buffer != NULL)
-    memcpy(&Field(res, 0), caml_backtrace_buffer,
-           caml_backtrace_pos * sizeof(code_t));
+
+  res = caml_alloc(caml_backtrace_pos, 0);
+  if(caml_backtrace_buffer != NULL) {
+    intnat i;
+    for(i = 0; i < caml_backtrace_pos; i++)
+      Field(res, i) = Val_Descrptr(caml_backtrace_buffer[i]);
+  }
   CAMLreturn(res);
 }
 
@@ -348,8 +355,19 @@ CAMLprim value caml_get_exception_raw_backtrace(value unit)
 CAMLprim value caml_get_exception_backtrace(value unit)
 {
   CAMLparam0();
-  CAMLlocal2(raw,res);
-  raw = caml_get_exception_raw_backtrace(unit);
-  res = caml_convert_raw_backtrace(raw);
+  CAMLlocal4(arr, raw_slot, slot, res);
+
+  arr = caml_alloc(caml_backtrace_pos, 0);
+  if (caml_backtrace_buffer == NULL) {
+      Assert(caml_backtrace_pos == 0);
+  } else {
+      intnat i;
+      for(i = 0; i < caml_backtrace_pos; i++) {
+          raw_slot = Val_Descrptr(caml_backtrace_buffer[i]);
+          slot = caml_convert_raw_backtrace_slot(raw_slot);
+          caml_modify(&Field(arr, i), slot);
+      }
+  }
+  res = caml_alloc_small(1, 0); Field(res, 0) = arr; /* Some */
   CAMLreturn(res);
 }
diff --git a/asmrun/fail.c b/asmrun/fail.c
index be625e10e5..cb2c1cbd77 100644
--- a/asmrun/fail.c
+++ b/asmrun/fail.c
@@ -104,7 +104,10 @@ void caml_raise_with_args(value tag, int nargs, value args[])
 
 void caml_raise_with_string(value tag, char const *msg)
 {
-  caml_raise_with_arg(tag, caml_copy_string(msg));
+  CAMLparam1(tag);
+  value v_msg = caml_copy_string(msg);
+  caml_raise_with_arg(tag, v_msg);
+  CAMLnoreturn;
 }
 
 void caml_failwith (char const *msg)
diff --git a/asmrun/i386.S b/asmrun/i386.S
index f880db2574..347e967c14 100644
--- a/asmrun/i386.S
+++ b/asmrun/i386.S
@@ -115,13 +115,10 @@
 #define PROFILE_C
 #endif
 
-#ifdef SYS_macosx
+/* PR#6038: GCC and Clang seem to require 16-byte alignment nowadays,
+   even if only MacOS X's ABI formally requires it. */	
 #define ALIGN_STACK(amount) subl $ amount, %esp ; CFI_ADJUST(amount)
 #define UNDO_ALIGN_STACK(amount) addl $ amount, %esp ; CFI_ADJUST(-amount)
-#else
-#define ALIGN_STACK(amount)
-#define UNDO_ALIGN_STACK(amount)
-#endif
 
 /* Allocation */
 
@@ -304,11 +301,7 @@ LBL(106):
 LBL(107):
     /* Pop the exception handler */
         popl    G(caml_exception_pointer); CFI_ADJUST(-4)
-#ifdef SYS_macosx
         addl    $12, %esp       ; CFI_ADJUST(-12)
-#else
-        addl    $4, %esp        ; CFI_ADJUST(-4)
-#endif
 LBL(109):
     /* Pop the callback link, restoring the global variables */
         popl    G(caml_bottom_of_stack); CFI_ADJUST(-4)
@@ -461,10 +454,8 @@ FUNCTION(caml_ml_array_bound_error)
         movl    %edx, G(caml_last_return_address)
         leal    4(%esp), %edx
         movl    %edx, G(caml_bottom_of_stack)
-    /* For MacOS X: re-align the stack */
-#ifdef SYS_macosx
+    /* Re-align the stack */
         andl    $-16, %esp
-#endif
     /* Branch to [caml_array_bound_error] (never returns) */
         call    G(caml_array_bound_error)
         CFI_ENDPROC
diff --git a/asmrun/natdynlink.c b/asmrun/natdynlink.c
index edb389dbb0..86c4f3e6f3 100644
--- a/asmrun/natdynlink.c
+++ b/asmrun/natdynlink.c
@@ -25,12 +25,11 @@
 #include <string.h>
 
 static void *getsym(void *handle, char *module, char *name){
-  char *fullname = malloc(strlen(module) + strlen(name) + 5);
+  char *fullname = caml_strconcat(3, "caml", module, name);
   void *sym;
-  sprintf(fullname, "caml%s%s", module, name);
   sym = caml_dlsym (handle, fullname);
   /*  printf("%s => %lx\n", fullname, (uintnat) sym); */
-  free(fullname);
+  caml_stat_free(fullname);
   return sym;
 }
 
diff --git a/asmrun/signals_osdep.h b/asmrun/signals_osdep.h
index 573e3a5716..23165ad680 100644
--- a/asmrun/signals_osdep.h
+++ b/asmrun/signals_osdep.h
@@ -267,9 +267,11 @@
      sigact.sa_flags = 0
 
   typedef unsigned long context_reg;
+  #define CONTEXT_PC (context->sc_frame.srr0)
   #define CONTEXT_EXCEPTION_POINTER (context->sc_frame.fixreg[29])
   #define CONTEXT_YOUNG_LIMIT (context->sc_frame.fixreg[30])
   #define CONTEXT_YOUNG_PTR (context->sc_frame.fixreg[31])
+  #define CONTEXT_SP (context->sc_frame.fixreg[1])
 
 /****************** SPARC, Solaris */
 
@@ -288,6 +290,7 @@
   #define CONTEXT_PC (context->uc_mcontext.gregs[REG_PC])
     /* Local register number N is saved on the stack N words
        after the stack pointer */
+  #define CONTEXT_SP (context->uc_mcontext.gregs[REG_SP])
   #define SPARC_L_REG(n) ((long *)(context->uc_mcontext.gregs[REG_SP]))[n]
   #define CONTEXT_EXCEPTION_POINTER (SPARC_L_REG(5))
   #define CONTEXT_YOUNG_LIMIT (SPARC_L_REG(7))
diff --git a/asmrun/stack.h b/asmrun/stack.h
index 9abd6e9ce0..92b3c28a35 100644
--- a/asmrun/stack.h
+++ b/asmrun/stack.h
@@ -25,7 +25,7 @@
 
 #ifdef TARGET_i386
 #define Saved_return_address(sp) *((intnat *)((sp) - 4))
-#ifdef SYS_macosx
+#ifndef SYS_win32
 #define Callback_link(sp) ((struct caml_context *)((sp) + 16))
 #else
 #define Callback_link(sp) ((struct caml_context *)((sp) + 8))
diff --git a/boot/ocamlc b/boot/ocamlc
index e2cbf0b76e..30553fc841 100755
--- a/boot/ocamlc
+++ b/boot/ocamlc
diff --git a/boot/ocamldep b/boot/ocamldep
index eeacb89e5a..409f30f971 100755
--- a/boot/ocamldep
+++ b/boot/ocamldep
diff --git a/boot/ocamllex b/boot/ocamllex
index 4f0a44e8b8..be5e1a4640 100755
--- a/boot/ocamllex
+++ b/boot/ocamllex
diff --git a/bytecomp/bytegen.ml b/bytecomp/bytegen.ml
index 47349d6f35..1a3767969c 100644
--- a/bytecomp/bytegen.ml
+++ b/bytecomp/bytegen.ml
@@ -146,7 +146,7 @@ let rec size_of_lambda = function
       begin match kind with
       | Record_regular | Record_inlined _ -> RHS_block size
       | Record_float -> RHS_floatblock size
-      | Record_exception _ -> RHS_block (size + 1)
+      | Record_extension _ -> RHS_block (size + 1)
       end
   | Llet(str, id, arg, body) -> size_of_lambda body
   | Lletrec(bindings, body) -> size_of_lambda body
@@ -157,7 +157,7 @@ let rec size_of_lambda = function
   | Lprim (Pmakearray Pgenarray, args) -> assert false
   | Lprim (Pduprecord ((Record_regular | Record_inlined _), size), args) ->
       RHS_block size
-  | Lprim (Pduprecord (Record_exception _, size), args) ->
+  | Lprim (Pduprecord (Record_extension _, size), args) ->
       RHS_block (size + 1)
   | Lprim (Pduprecord (Record_float, size), args) -> RHS_floatblock size
   | Levent (lam, _) -> size_of_lambda lam
@@ -237,9 +237,15 @@ let add_event ev =
 
 (**** Compilation of a lambda expression ****)
 
-(* association staticraise numbers -> (lbl,size of stack *)
+let try_blocks = ref []  (* list of stack size for each nested try block *)
+
+(* association staticraise numbers -> (lbl,size of stack, try_blocks *)
 
 let sz_static_raises = ref []
+
+let push_static_raise i lbl_handler sz =
+  sz_static_raises := (i, (lbl_handler, sz, !try_blocks)) :: !sz_static_raises
+
 let find_raise_label i =
   try
     List.assoc i !sz_static_raises
@@ -251,8 +257,8 @@ let find_raise_label i =
 (* Will the translation of l lead to a jump to label ? *)
 let code_as_jump l sz = match l with
 | Lstaticraise (i,[]) ->
-    let label,size = find_raise_label i in
-    if sz = size then
+    let label,size,tb = find_raise_label i in
+    if sz = size && tb == !try_blocks then
       Some label
     else
       None
@@ -405,6 +411,7 @@ let comp_primitive p args =
   | Pbigstring_set_64(_) -> Kccall("caml_ba_uint8_set64", 3)
   | Pbswap16 -> Kccall("caml_bswap16", 1)
   | Pbbswap(bi) -> comp_bint_primitive bi "bswap" args
+  | Pint_as_pointer -> Kccall("caml_int_as_pointer", 1)
   | _ -> fatal_error "Bytegen.comp_primitive"
 
 let is_immed n = immed_min <= n && n <= immed_max
@@ -640,8 +647,7 @@ let rec comp_expr env exp sz cont =
               (comp_expr
                 (add_vars vars (sz+1) env)
                 handler (sz+nvars) (add_pop nvars cont1)) in
-          sz_static_raises :=
-            (i, (lbl_handler, sz+nvars)) :: !sz_static_raises ;
+          push_static_raise i lbl_handler (sz+nvars);
           push_dummies nvars
             (comp_expr env body (sz+nvars)
             (add_pop nvars (branch1 :: cont2)))
@@ -652,30 +658,39 @@ let rec comp_expr env exp sz cont =
               (Kpush::comp_expr
                 (add_var var (sz+1) env)
                 handler (sz+1) (add_pop 1 cont1)) in
-          sz_static_raises :=
-            (i, (lbl_handler, sz)) :: !sz_static_raises ;
+          push_static_raise i lbl_handler sz;
           comp_expr env body sz (branch1 :: cont2)
         end in
       sz_static_raises := List.tl !sz_static_raises ;
       r
   | Lstaticraise (i, args) ->
       let cont = discard_dead_code cont in
-      let label,size = find_raise_label i in
+      let label,size,tb = find_raise_label i in
+      let cont = branch_to label cont in
+      let rec loop sz tbb =
+        if tb == tbb then add_pop (sz-size) cont
+        else match tbb with
+        | [] -> assert false
+        | try_sz :: tbb -> add_pop (sz-try_sz-4) (Kpoptrap :: loop try_sz tbb)
+      in
+      let cont = loop sz !try_blocks in
       begin match args with
       | [arg] -> (* optim, argument passed in accumulator *)
-          comp_expr env arg sz
-            (add_pop (sz-size) (branch_to label cont))
-      | _ ->
-          comp_exit_args env args sz size
-            (add_pop (sz-size) (branch_to label cont))
+          comp_expr env arg sz cont
+      | _ -> comp_exit_args env args sz size cont
       end
   | Ltrywith(body, id, handler) ->
       let (branch1, cont1) = make_branch cont in
       let lbl_handler = new_label() in
-      Kpushtrap lbl_handler ::
-        comp_expr env body (sz+4) (Kpoptrap :: branch1 ::
-          Klabel lbl_handler :: Kpush ::
-            comp_expr (add_var id (sz+1) env) handler (sz+1) (add_pop 1 cont1))
+      let body_cont =
+        Kpoptrap :: branch1 ::
+        Klabel lbl_handler :: Kpush ::
+        comp_expr (add_var id (sz+1) env) handler (sz+1) (add_pop 1 cont1)
+      in
+      try_blocks := sz :: !try_blocks;
+      let l = comp_expr env body (sz+4) body_cont in
+      try_blocks := List.tl !try_blocks;
+      Kpushtrap lbl_handler :: l
   | Lifthenelse(cond, ifso, ifnot) ->
       comp_binary_test env cond ifso ifnot sz cont
   | Lsequence(exp1, exp2) ->
@@ -919,3 +934,10 @@ let compile_phrase expr =
   let init_code = comp_block empty_env expr 1 [Kreturn 1] in
   let fun_code = comp_remainder [] in
   (init_code, fun_code)
+
+let reset () =
+  label_counter := 0;
+  sz_static_raises := [];
+  compunit_name := "";
+  Stack.clear functions_to_compile;
+  max_stack_used := 0
diff --git a/bytecomp/bytegen.mli b/bytecomp/bytegen.mli
index 3c24cc8e86..24f1d64f32 100644
--- a/bytecomp/bytegen.mli
+++ b/bytecomp/bytegen.mli
@@ -17,3 +17,4 @@ open Instruct
 
 val compile_implementation: string -> lambda -> instruction list
 val compile_phrase: lambda -> instruction list * instruction list
+val reset: unit -> unit
diff --git a/bytecomp/bytelibrarian.ml b/bytecomp/bytelibrarian.ml
index c63cf80ec2..7c96dfd0e7 100644
--- a/bytecomp/bytelibrarian.ml
+++ b/bytecomp/bytelibrarian.ml
@@ -60,7 +60,7 @@ let copy_object_file ppf oc name =
       raise(Error(File_not_found name)) in
   let ic = open_in_bin file_name in
   try
-    let buffer = input_bytes ic (String.length cmo_magic_number) in
+    let buffer = really_input_string ic (String.length cmo_magic_number) in
     if buffer = cmo_magic_number then begin
       let compunit_pos = input_binary_int ic in
       seek_in ic compunit_pos;
@@ -124,3 +124,8 @@ let () =
       | Error err -> Some (Location.error_of_printer_file report_error err)
       | _ -> None
     )
+
+let reset () =
+  lib_ccobjs := [];
+  lib_ccopts := [];
+  lib_dllibs := []
diff --git a/bytecomp/bytelibrarian.mli b/bytecomp/bytelibrarian.mli
index 757874cb49..b9a4ced849 100644
--- a/bytecomp/bytelibrarian.mli
+++ b/bytecomp/bytelibrarian.mli
@@ -30,3 +30,5 @@ exception Error of error
 open Format
 
 val report_error: formatter -> error -> unit
+
+val reset: unit -> unit
diff --git a/bytecomp/bytelink.ml b/bytecomp/bytelink.ml
index 75db3533c9..c0f8f6a935 100644
--- a/bytecomp/bytelink.ml
+++ b/bytecomp/bytelink.ml
@@ -113,7 +113,7 @@ let scan_file obj_name tolink =
       raise(Error(File_not_found obj_name)) in
   let ic = open_in_bin file_name in
   try
-    let buffer = input_bytes ic (String.length cmo_magic_number) in
+    let buffer = really_input_string ic (String.length cmo_magic_number) in
     if buffer = cmo_magic_number then begin
       (* This is a .cmo file. It must be linked in any case.
          Read the relocation information to see which modules it
@@ -158,15 +158,20 @@ let scan_file obj_name tolink =
 (* Consistency check between interfaces *)
 
 let crc_interfaces = Consistbl.create ()
+let interfaces = ref ([] : string list)
 let implementations_defined = ref ([] : (string * string) list)
 
 let check_consistency ppf file_name cu =
   begin try
     List.iter
-      (fun (name, crc) ->
-        if name = cu.cu_name
-        then Consistbl.set crc_interfaces name crc file_name
-        else Consistbl.check crc_interfaces name crc file_name)
+      (fun (name, crco) ->
+        interfaces := name :: !interfaces;
+        match crco with
+          None -> ()
+        | Some crc ->
+            if name = cu.cu_name
+            then Consistbl.set crc_interfaces name crc file_name
+            else Consistbl.check crc_interfaces name crc file_name)
       cu.cu_imports
   with Consistbl.Inconsistency(name, user, auth) ->
     raise(Error(Inconsistent_import(name, user, auth)))
@@ -183,7 +188,11 @@ let check_consistency ppf file_name cu =
     (cu.cu_name, file_name) :: !implementations_defined
 
 let extract_crc_interfaces () =
-  Consistbl.extract crc_interfaces
+  Consistbl.extract !interfaces crc_interfaces
+
+let clear_crc_interfaces () =
+  Consistbl.clear crc_interfaces;
+  interfaces := []
 
 (* Record compilation events *)
 
@@ -256,7 +265,7 @@ let output_debug_info oc =
   List.iter
     (fun (ofs, evl) ->
       output_binary_int oc ofs;
-      Array.iter (output_string oc) evl)
+      Array.iter (output_bytes oc) evl)
     !debug_info;
   debug_info := []
 
@@ -307,7 +316,7 @@ let link_bytecode ppf tolink exec_name standalone =
     (* The bytecode *)
     let start_code = pos_out outchan in
     Symtable.init();
-    Consistbl.clear crc_interfaces;
+    clear_crc_interfaces ();
     let sharedobjs = List.map Dll.extract_dll_name !Clflags.dllibs in
     let check_dlls = standalone && Config.target = Config.host in
     if check_dlls then begin
@@ -317,7 +326,7 @@ let link_bytecode ppf tolink exec_name standalone =
       try Dll.open_dlls Dll.For_checking sharedobjs
       with Failure reason -> raise(Error(Cannot_open_dll reason))
     end;
-    let output_fun = output_string outchan
+    let output_fun = output_bytes outchan
     and currpos_fun () = pos_out outchan - start_code in
     List.iter (link_file ppf output_fun currpos_fun) tolink;
     if check_dlls then Dll.close_all_dlls();
@@ -371,12 +380,12 @@ let output_code_string_counter = ref 0
 
 let output_code_string outchan code =
   let pos = ref 0 in
-  let len = String.length code in
+  let len = Bytes.length code in
   while !pos < len do
-    let c1 = Char.code(code.[!pos]) in
-    let c2 = Char.code(code.[!pos + 1]) in
-    let c3 = Char.code(code.[!pos + 2]) in
-    let c4 = Char.code(code.[!pos + 3]) in
+    let c1 = Char.code(Bytes.get code !pos) in
+    let c2 = Char.code(Bytes.get code (!pos + 1)) in
+    let c3 = Char.code(Bytes.get code (!pos + 2)) in
+    let c4 = Char.code(Bytes.get code (!pos + 3)) in
     pos := !pos + 4;
     Printf.fprintf outchan "0x%02x%02x%02x%02x, " c4 c3 c2 c1;
     incr output_code_string_counter;
@@ -440,11 +449,11 @@ let link_bytecode_as_c ppf tolink outfile =
 \n           char **argv);\n";
     output_string outchan "static int caml_code[] = {\n";
     Symtable.init();
-    Consistbl.clear crc_interfaces;
+    clear_crc_interfaces ();
     let currpos = ref 0 in
     let output_fun code =
       output_code_string outchan code;
-      currpos := !currpos + String.length code
+      currpos := !currpos + Bytes.length code
     and currpos_fun () = !currpos in
     List.iter (link_file ppf output_fun currpos_fun) tolink;
     (* The final STOP instruction *)
@@ -629,3 +638,13 @@ let () =
       | Error err -> Some (Location.error_of_printer_file report_error err)
       | _ -> None
     )
+
+let reset () =
+  lib_ccobjs := [];
+  lib_ccopts := [];
+  lib_dllibs := [];
+  missing_globals := IdentSet.empty;
+  Consistbl.clear crc_interfaces;
+  implementations_defined := [];
+  debug_info := [];
+  output_code_string_counter := 0
diff --git a/bytecomp/bytelink.mli b/bytecomp/bytelink.mli
index 6e123c3f53..37dad2b526 100644
--- a/bytecomp/bytelink.mli
+++ b/bytecomp/bytelink.mli
@@ -13,11 +13,12 @@
 (* Link .cmo files and produce a bytecode executable. *)
 
 val link : Format.formatter -> string list -> string -> unit
+val reset : unit -> unit
 
 val check_consistency:
   Format.formatter -> string -> Cmo_format.compilation_unit -> unit
 
-val extract_crc_interfaces: unit -> (string * Digest.t) list
+val extract_crc_interfaces: unit -> (string * Digest.t option) list
 
 type error =
     File_not_found of string
diff --git a/bytecomp/bytepackager.ml b/bytecomp/bytepackager.ml
index 23582c1cb2..3348f46dcd 100644
--- a/bytecomp/bytepackager.ml
+++ b/bytecomp/bytepackager.ml
@@ -101,7 +101,9 @@ let read_member_info file = (
     if Filename.check_suffix file ".cmo" then begin
     let ic = open_in_bin file in
     try
-      let buffer = input_bytes ic (String.length Config.cmo_magic_number) in
+      let buffer =
+        really_input_string ic (String.length Config.cmo_magic_number)
+      in
       if buffer <> Config.cmo_magic_number then
         raise(Error(Not_an_object_file file));
       let compunit_pos = input_binary_int ic in
@@ -233,7 +235,8 @@ let package_object_files ppf files targetfile targetname coercion =
         cu_pos = pos_code;
         cu_codesize = pos_debug - pos_code;
         cu_reloc = List.rev !relocs;
-        cu_imports = (targetname, Env.crc_of_unit targetname) :: imports;
+        cu_imports =
+          (targetname, Some (Env.crc_of_unit targetname)) :: imports;
         cu_primitives = !primitives;
         cu_force_link = !force_link;
         cu_debug = if pos_final > pos_debug then pos_debug else 0;
@@ -248,7 +251,7 @@ let package_object_files ppf files targetfile targetname coercion =
 
 (* The entry point *)
 
-let package_files ppf files targetfile =
+let package_files ppf initial_env files targetfile =
     let files =
     List.map
         (fun f ->
@@ -259,11 +262,12 @@ let package_files ppf files targetfile =
     let targetcmi = prefix ^ ".cmi" in
     let targetname = String.capitalize(Filename.basename prefix) in
     try
-      let coercion = Typemod.package_units files targetcmi targetname in
-    let ret = package_object_files ppf files targetfile targetname coercion in
-    ret
-  with x ->
-    remove_file targetfile; raise x
+      let coercion =
+        Typemod.package_units initial_env files targetcmi targetname in
+      let ret = package_object_files ppf files targetfile targetname coercion in
+      ret
+    with x ->
+      remove_file targetfile; raise x
 
 (* Error report *)
 
@@ -293,3 +297,9 @@ let () =
       | Error err -> Some (Location.error_of_printer_file report_error err)
       | _ -> None
     )
+
+let reset () =
+  relocs := [];
+  events := [];
+  primitives := [];
+  force_link := false
diff --git a/bytecomp/bytepackager.mli b/bytecomp/bytepackager.mli
index 04de0726a2..69e3c77acb 100644
--- a/bytecomp/bytepackager.mli
+++ b/bytecomp/bytepackager.mli
@@ -13,7 +13,7 @@
 (* "Package" a set of .cmo files into one .cmo file having the
    original compilation units as sub-modules. *)
 
-val package_files: Format.formatter -> string list -> string -> unit
+val package_files: Format.formatter -> Env.t -> string list -> string -> unit
 
 type error =
     Forward_reference of string * Ident.t
@@ -25,3 +25,4 @@ type error =
 exception Error of error
 
 val report_error: Format.formatter -> error -> unit
+val reset: unit -> unit
diff --git a/bytecomp/bytesections.ml b/bytecomp/bytesections.ml
index 5af3bc5237..759bde3b29 100644
--- a/bytecomp/bytesections.ml
+++ b/bytecomp/bytesections.ml
@@ -46,12 +46,14 @@ let read_toc ic =
   let pos_trailer = in_channel_length ic - 16 in
   seek_in ic pos_trailer;
   let num_sections = input_binary_int ic in
-  let header = Misc.input_bytes ic (String.length Config.exec_magic_number) in
+  let header =
+    really_input_string ic (String.length Config.exec_magic_number)
+  in
   if header <> Config.exec_magic_number then raise Bad_magic_number;
   seek_in ic (pos_trailer - 8 * num_sections);
   section_table := [];
   for _i = 1 to num_sections do
-    let name = Misc.input_bytes ic 4 in
+    let name = really_input_string ic 4 in
     let len = input_binary_int ic in
     section_table := (name, len) :: !section_table
   done
@@ -77,7 +79,7 @@ let seek_section ic name =
 (* Return the contents of a section, as a string *)
 
 let read_section_string ic name =
-  Misc.input_bytes ic (seek_section ic name)
+  really_input_string ic (seek_section ic name)
 
 (* Return the contents of a section, as marshalled data *)
 
@@ -90,3 +92,7 @@ let read_section_struct ic name =
 let pos_first_section ic =
   in_channel_length ic - 16 - 8 * List.length !section_table -
   List.fold_left (fun total (name, len) -> total + len) 0 !section_table
+
+let reset () =
+  section_table := [];
+  section_beginning := 0
diff --git a/bytecomp/bytesections.mli b/bytecomp/bytesections.mli
index b9639c1fac..12e679d73f 100644
--- a/bytecomp/bytesections.mli
+++ b/bytecomp/bytesections.mli
@@ -50,3 +50,5 @@ val read_section_struct: in_channel -> string -> 'a
 
 val pos_first_section: in_channel -> int
    (* Return the position of the beginning of the first section *)
+
+val reset: unit -> unit
diff --git a/bytecomp/cmo_format.mli b/bytecomp/cmo_format.mli
index abf4f1af32..0c0f08f080 100644
--- a/bytecomp/cmo_format.mli
+++ b/bytecomp/cmo_format.mli
@@ -27,7 +27,8 @@ type compilation_unit =
     mutable cu_pos: int;                (* Absolute position in file *)
     cu_codesize: int;                   (* Size of code block *)
     cu_reloc: (reloc_info * int) list;  (* Relocation information *)
-    cu_imports: (string * Digest.t) list; (* Names and CRC of intfs imported *)
+    cu_imports:
+      (string * Digest.t option) list; (* Names and CRC of intfs imported *)
     cu_primitives: string list;         (* Primitives declared inside *)
     mutable cu_force_link: bool;        (* Must be linked even if unref'ed *)
     mutable cu_debug: int;              (* Position of debugging info, or 0 *)
diff --git a/bytecomp/dll.ml b/bytecomp/dll.ml
index 5c62b9edc3..21688e08ee 100644
--- a/bytecomp/dll.ml
+++ b/bytecomp/dll.ml
@@ -173,3 +173,9 @@ let init_toplevel dllpath =
   opened_dlls := Array.to_list (get_current_dlls());
   names_of_opened_dlls := [];
   linking_in_core := true
+
+let reset () =
+  search_path := [];
+  opened_dlls :=[];
+  names_of_opened_dlls := [];
+  linking_in_core := false
diff --git a/bytecomp/dll.mli b/bytecomp/dll.mli
index 975315e268..878ffb919e 100644
--- a/bytecomp/dll.mli
+++ b/bytecomp/dll.mli
@@ -59,3 +59,5 @@ val init_compile: bool -> unit
    contents of ld.conf file).  Take note of the DLLs that were opened
    when starting the running program. *)
 val init_toplevel: string -> unit
+
+val reset: unit -> unit
diff --git a/bytecomp/emitcode.ml b/bytecomp/emitcode.ml
index a56bf9175b..95b9a20f59 100644
--- a/bytecomp/emitcode.ml
+++ b/bytecomp/emitcode.ml
@@ -381,7 +381,7 @@ let to_file outchan unit_name code =
       cu_pos = pos_code;
       cu_codesize = !out_position;
       cu_reloc = List.rev !reloc_info;
-      cu_imports = Env.imported_units();
+      cu_imports = Env.imports();
       cu_primitives = List.map Primitive.byte_name
                                !Translmod.primitive_declarations;
       cu_force_link = false;
@@ -402,7 +402,7 @@ let to_memory init_code fun_code =
   emit init_code;
   emit fun_code;
   let code = Meta.static_alloc !out_position in
-  LongString.unsafe_blit_to_string !out_buffer 0 code 0 !out_position;
+  LongString.unsafe_blit_to_bytes !out_buffer 0 code 0 !out_position;
   let reloc = List.rev !reloc_info
   and code_size = !out_position in
   init();
@@ -417,3 +417,9 @@ let to_packed_file outchan code =
   let reloc = !reloc_info in
   init();
   reloc
+
+let reset () =
+  out_buffer := LongString.create 1024;
+  out_position := 0;
+  label_table := [| |];
+  reloc_info := []
diff --git a/bytecomp/emitcode.mli b/bytecomp/emitcode.mli
index 60d791434a..ee0bccbf0d 100644
--- a/bytecomp/emitcode.mli
+++ b/bytecomp/emitcode.mli
@@ -21,7 +21,7 @@ val to_file: out_channel -> string -> instruction list -> unit
              name of compilation unit implemented
              list of instructions to emit *)
 val to_memory: instruction list -> instruction list ->
-                    string * int * (reloc_info * int) list
+                    bytes * int * (reloc_info * int) list
         (* Arguments:
              initialization code (terminated by STOP)
              function code
@@ -36,3 +36,5 @@ val to_packed_file:
              list of instructions to emit
            Result:
              relocation information (reversed) *)
+
+val reset: unit -> unit
diff --git a/bytecomp/lambda.ml b/bytecomp/lambda.ml
index f68588090b..3c1aaf26bb 100644
--- a/bytecomp/lambda.ml
+++ b/bytecomp/lambda.ml
@@ -121,6 +121,8 @@ type primitive =
   (* byte swap *)
   | Pbswap16
   | Pbbswap of boxed_integer
+  (* Integer to external pointer *)
+  | Pint_as_pointer
 
 and comparison =
     Ceq | Cneq | Clt | Cgt | Cle | Cge
@@ -209,16 +211,23 @@ let const_unit = Const_pointer 0
 
 let lambda_unit = Lconst const_unit
 
+(* Build sharing keys *)
+(*
+   Those keys are later compared with Pervasives.compare.
+   For that reason, they should not include cycles.
+*)
+
 exception Not_simple
 
 let max_raw = 32
 
 let make_key e =
-  let count = ref 0
+  let count = ref 0   (* Used for controling size *)
   and make_key = Ident.make_key_generator () in
+  (* make_key is used for normalizing let-bound variables *)
   let rec tr_rec env e =
     incr count ;
-    if !count > max_raw then raise Not_simple ;
+    if !count > max_raw then raise Not_simple ; (* Too big ! *)
     match e with
     | Lvar id ->
       begin
@@ -262,11 +271,12 @@ let make_key e =
         Lassign (x,tr_rec env e)
     | Lsend (m,e1,e2,es,loc) ->
         Lsend (m,tr_rec env e1,tr_rec env e2,tr_recs env es,Location.none)
-    | Levent (e,evt) ->
-        Levent (tr_rec env e,evt)
     | Lifused (id,e) -> Lifused (id,tr_rec env e)
     | Lletrec _|Lfunction _
-    | Lfor _ | Lwhile _  ->
+    | Lfor _ | Lwhile _
+(* Beware: (PR#6412) the event argument to Levent
+   may include cyclic structure of type Type.typexpr *)
+    | Levent _  ->
         raise Not_simple
 
   and tr_recs env es = List.map (tr_rec env) es
@@ -399,6 +409,12 @@ let next_raise_count () =
   incr raise_count ;
   !raise_count
 
+let negative_raise_count = ref 0
+
+let next_negative_raise_count () =
+  decr negative_raise_count ;
+  !negative_raise_count
+
 (* Anticipated staticraise, for guards *)
 let staticfail = Lstaticraise (0,[])
 
@@ -529,3 +545,7 @@ let lam_of_loc kind loc =
         file lnum cnum enum in
     Lconst (Const_immstring loc)
   | Loc_LINE -> Lconst (Const_base (Const_int lnum))
+
+let reset () =
+  raise_count := 0
+
diff --git a/bytecomp/lambda.mli b/bytecomp/lambda.mli
index 8acb4cd03e..2448087da7 100644
--- a/bytecomp/lambda.mli
+++ b/bytecomp/lambda.mli
@@ -121,6 +121,8 @@ type primitive =
   (* byte swap *)
   | Pbswap16
   | Pbbswap of boxed_integer
+  (* Integer to external pointer *)
+  | Pint_as_pointer
 
 and comparison =
     Ceq | Cneq | Clt | Cgt | Cle | Cge
@@ -244,7 +246,10 @@ val negate_comparison : comparison -> comparison
 
 (* Get a new static failure ident *)
 val next_raise_count : unit -> int
-
+val next_negative_raise_count : unit -> int
+  (* Negative raise counts are used to compile 'match ... with exception x -> ...'.
+     This disabled some simplifications performed by the Simplif module that assume
+     that static raises are in tail position in their handler. *)
 
 val staticfail : lambda (* Anticipated static failure *)
 
@@ -254,3 +259,5 @@ val patch_guarded : lambda -> lambda -> lambda
 
 val raise_kind: raise_kind -> string
 val lam_of_loc : loc_kind -> Location.t -> lambda
+
+val reset: unit -> unit
diff --git a/bytecomp/matching.ml b/bytecomp/matching.ml
index b1036ec9a5..5a8f71efcd 100644
--- a/bytecomp/matching.ml
+++ b/bytecomp/matching.ml
@@ -169,7 +169,7 @@ let ctx_matcher p =
   match p.pat_desc with
   | Tpat_construct (_, cstr,omegas) ->
       begin match cstr.cstr_tag with
-      | Cstr_exception _ -> (* exception matching *)
+      | Cstr_extension _ ->
           let nargs = List.length omegas in
           (fun q rem -> match q.pat_desc with
           | Tpat_construct (_, cstr',args)
@@ -531,15 +531,14 @@ let up_ok_action act1 act2 =
   try
     let raw1 = tr_raw act1
     and raw2 = tr_raw act2 in
-    match raw1, raw2 with
-    | Lstaticraise (i1,[]), Lstaticraise (i2,[]) -> i1=i2
-    | _,_ -> raw1 = raw2
+    raw1 = raw2
   with
   | Exit -> false
 
-(* Nothing is kown about exception patterns, because of potential rebind *)
+(* Nothing is kown about exception/extension patterns,
+   because of potential rebind *)
 let rec exc_inside p = match p.pat_desc with
-  | Tpat_construct (_,{cstr_tag=Cstr_exception _},_) -> true
+  | Tpat_construct (_,{cstr_tag=Cstr_extension _},_) -> true
   | Tpat_any|Tpat_constant _|Tpat_var _
   | Tpat_construct (_,_,[])
   | Tpat_variant (_,None,_)
@@ -661,7 +660,7 @@ let rec what_is_cases cases = match cases with
 (* A few operation on default environments *)
 let as_matrix cases = get_mins le_pats (List.map (fun (ps,_) -> ps) cases)
 
-(* For exception matching, record no imformation in matrix *)
+(* For extension matching, record no imformation in matrix *)
 let as_matrix_omega cases =
   get_mins le_pats
     (List.map
@@ -937,9 +936,8 @@ let rec split_or argo cls args def =
 
   do_split [] [] [] cls
 
-(* Ultra-naive spliting, close to semantics,
-   used for exception, as potential rebind prevents any kind of
-   optimisation *)
+(* Ultra-naive spliting, close to semantics, used for extension,
+   as potential rebind prevents any kind of optimisation *)
 
 and split_naive cls args def k =
 
@@ -1004,7 +1002,7 @@ and split_constr cls args def k =
   let ex_pat = what_is_cases cls in
   match ex_pat.pat_desc with
   | Tpat_any -> precompile_var args cls def k
-  | Tpat_construct (_,{cstr_tag=Cstr_exception _},_) ->
+  | Tpat_construct (_,{cstr_tag=Cstr_extension _},_) ->
       split_naive cls args def k
   | _ ->
 
@@ -1114,7 +1112,7 @@ and dont_precompile_var args cls def k =
 and is_exc p = match p.pat_desc with
 | Tpat_or (p1,p2,_) -> is_exc p1 || is_exc p2
 | Tpat_alias (p,v,_) -> is_exc p
-| Tpat_construct (_,{cstr_tag = Cstr_exception _},_) -> true
+| Tpat_construct (_,{cstr_tag=Cstr_extension _},_) -> true
 | _ -> false
 
 and precompile_or argo cls ors args def k = match ors with
@@ -1355,7 +1353,7 @@ let make_constr_matching p def ctx = function
         else match cstr.cstr_tag with
           Cstr_constant _ | Cstr_block _ ->
             make_field_args Alias arg 0 (cstr.cstr_arity - 1) argl
-        | Cstr_exception _ ->
+        | Cstr_extension _ ->
             make_field_args Alias arg 1 cstr.cstr_arity argl in
       {pm=
         {cases = []; args = newargs;
@@ -1486,7 +1484,7 @@ let get_mod_field modname field =
   lazy (
     try
       let mod_ident = Ident.create_persistent modname in
-      let env = Env.open_pers_signature modname Env.initial in
+      let env = Env.open_pers_signature modname Env.initial_safe_string in
       let p = try
         match Env.lookup_value (Longident.Lident field) env with
         | (Path.Pdot(_,_,i), _) -> i
@@ -1634,7 +1632,7 @@ let make_record_matching all_labels def = function
             match lbl.lbl_repres with
               Record_regular | Record_inlined _ -> Pfield lbl.lbl_pos
             | Record_float -> Pfloatfield lbl.lbl_pos
-            | Record_exception _ -> Pfield (lbl.lbl_pos + 1)
+            | Record_extension _ -> Pfield (lbl.lbl_pos + 1)
           in
           let str =
             match lbl.lbl_mut with
@@ -2365,39 +2363,61 @@ let split_cases tag_lambda_list =
   sort_int_lambda_list const,
   sort_int_lambda_list nonconst
 
+let split_extension_cases tag_lambda_list =
+  let rec split_rec = function
+      [] -> ([], [])
+    | (cstr, act) :: rem ->
+        let (consts, nonconsts) = split_rec rem in
+        match cstr with
+          Cstr_extension(path, true) -> ((path, act) :: consts, nonconsts)
+        | Cstr_extension(path, false) -> (consts, (path, act) :: nonconsts)
+        | _ -> assert false in
+  split_rec tag_lambda_list
+
 
 let combine_constructor arg ex_pat cstr partial ctx def
     (tag_lambda_list, total1, pats) =
   if cstr.cstr_consts < 0 then begin
-    (* Special cases for exceptions *)
+    (* Special cases for extensions *)
     let fail, to_add, local_jumps =
       mk_failaction_neg partial ctx def in
     let tag_lambda_list = to_add@tag_lambda_list in
     let lambda1 =
-      let default, tests =
+      let consts, nonconsts = split_extension_cases tag_lambda_list in
+      let default, consts, nonconsts =
         match fail with
         | None ->
-            begin match tag_lambda_list with
-            | (_, act)::rem -> act,rem
+            begin match consts, nonconsts with
+            | _, (_, act)::rem -> act, consts, rem
+            | (_, act)::rem, _ -> act, rem, nonconsts
             | _ -> assert false
             end
-        | Some fail -> fail, tag_lambda_list in
-      List.fold_right
-        (fun (ex, act) rem ->
-           assert(ex = cstr.cstr_tag);
-          match ex with
-          | Cstr_exception (path, _) ->
-              let slot =
-                if cstr.cstr_arity = 0 then arg
-                else Lprim(Pfield 0, [arg])
-              in
-              Lifthenelse(Lprim(Pintcomp Ceq,
-                                [slot;
-                                 transl_path ~loc:ex_pat.pat_loc
-                                   ex_pat.pat_env path]),
-                          act, rem)
-          | _ -> assert false)
-        tests default in
+        | Some fail -> fail, consts, nonconsts in
+      let nonconst_lambda =
+        match nonconsts with
+          [] -> default
+        | _ ->
+            let tag = Ident.create "tag" in
+            let tests =
+              List.fold_right
+                (fun (path, act) rem ->
+                   Lifthenelse(Lprim(Pintcomp Ceq,
+                                     [Lvar tag;
+                                      transl_path ex_pat.pat_env path]),
+                               act, rem))
+                nonconsts
+                default
+            in
+              Llet(Alias, tag, Lprim(Pfield 0, [arg]), tests)
+      in
+        List.fold_right
+          (fun (path, act) rem ->
+             Lifthenelse(Lprim(Pintcomp Ceq,
+                               [arg; transl_path ex_pat.pat_env path]),
+                         act, rem))
+          consts
+          nonconst_lambda
+    in
     lambda1, jumps_union local_jumps total1
   end else begin
     (* Regular concrete type *)
diff --git a/bytecomp/meta.ml b/bytecomp/meta.ml
index 35d8776666..f7711ff15e 100644
--- a/bytecomp/meta.ml
+++ b/bytecomp/meta.ml
@@ -12,13 +12,13 @@
 
 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_resize : string -> int -> string = "caml_static_resize"
-external static_release_bytecode : string -> int -> unit
+external static_alloc : int -> bytes = "caml_static_alloc"
+external static_free : bytes -> unit = "caml_static_free"
+external static_resize : bytes -> int -> bytes = "caml_static_resize"
+external static_release_bytecode : bytes -> int -> unit
                                  = "caml_static_release_bytecode"
 type closure = unit -> Obj.t
-external reify_bytecode : string -> int -> closure = "caml_reify_bytecode"
+external reify_bytecode : bytes -> int -> closure = "caml_reify_bytecode"
 external invoke_traced_function : Obj.t -> Obj.t -> Obj.t -> Obj.t
                                 = "caml_invoke_traced_function"
 external get_section_table : unit -> (string * Obj.t) list
diff --git a/bytecomp/meta.mli b/bytecomp/meta.mli
index a8ef5272aa..cb3565dcc8 100644
--- a/bytecomp/meta.mli
+++ b/bytecomp/meta.mli
@@ -14,13 +14,13 @@
 
 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
+external static_alloc : int -> bytes = "caml_static_alloc"
+external static_free : bytes -> unit = "caml_static_free"
+external static_release_bytecode : bytes -> int -> unit
                                  = "caml_static_release_bytecode"
-external static_resize : string -> int -> string = "caml_static_resize"
+external static_resize : bytes -> int -> bytes = "caml_static_resize"
 type closure = unit -> Obj.t
-external reify_bytecode : string -> int -> closure = "caml_reify_bytecode"
+external reify_bytecode : bytes -> int -> closure = "caml_reify_bytecode"
 external invoke_traced_function : Obj.t -> Obj.t -> Obj.t -> Obj.t
                                 = "caml_invoke_traced_function"
 external get_section_table : unit -> (string * Obj.t) list
diff --git a/bytecomp/printlambda.ml b/bytecomp/printlambda.ml
index 006c8e2798..12985c53c0 100644
--- a/bytecomp/printlambda.ml
+++ b/bytecomp/printlambda.ml
@@ -86,7 +86,7 @@ let record_rep ppf r =
   | Record_regular -> fprintf ppf "regular"
   | Record_inlined i -> fprintf ppf "inlined(%i)" i
   | Record_float -> fprintf ppf "float"
-  | Record_exception p -> fprintf ppf "exn (%s)" (Path.name p)
+  | Record_extension p -> fprintf ppf "ext (%s)" (Path.name p)
 ;;
 
 let string_of_loc_kind = function
@@ -239,6 +239,7 @@ let primitive ppf = function
      else fprintf ppf "bigarray.array1.set64"
   | Pbswap16 -> fprintf ppf "bswap16"
   | Pbbswap(bi) -> print_boxed_integer "bswap" ppf bi
+  | Pint_as_pointer -> fprintf ppf "int_as_pointer"
 
 let rec lam ppf = function
   | Lvar id ->
diff --git a/bytecomp/simplif.ml b/bytecomp/simplif.ml
index 85f0d71f9d..fd3d21c173 100644
--- a/bytecomp/simplif.ml
+++ b/bytecomp/simplif.ml
@@ -256,7 +256,7 @@ let simplify_exits lam =
   | Lstaticcatch (l1,(i,xs),l2) ->
       begin match count_exit i with
       | 0 -> simplif l1
-      | 1 ->
+      | 1 when i >= 0 ->
           Hashtbl.add subst i (xs,simplif l2) ;
           simplif l1
       | _ ->
diff --git a/bytecomp/symtable.ml b/bytecomp/symtable.ml
index baff51c486..37609d7751 100644
--- a/bytecomp/symtable.ml
+++ b/bytecomp/symtable.ml
@@ -198,7 +198,7 @@ let gen_patch_object str_set buff patchlist =
           gen_patch_int str_set buff pos (num_of_prim name))
     patchlist
 
-let patch_object = gen_patch_object String.unsafe_set
+let patch_object = gen_patch_object Bytes.unsafe_set
 let ls_patch_object = gen_patch_object LongString.set
 
 (* Translate structured constants *)
@@ -300,7 +300,7 @@ let init_toplevel () =
     Dll.init_toplevel dllpath;
     (* Recover CRC infos for interfaces *)
     let crcintfs =
-      try (Obj.magic (sect.read_struct "CRCS") : (string * Digest.t) list)
+      try (Obj.magic (sect.read_struct "CRCS") : (string * Digest.t option) list)
       with Not_found -> [] in
     (* Done *)
     sect.close_reader();
@@ -383,3 +383,8 @@ let () =
       | Error err -> Some (Location.error_of_printer_file report_error err)
       | _ -> None
     )
+
+let reset () =
+  global_table := empty_numtable;
+  literal_table := [];
+  c_prim_table := empty_numtable
diff --git a/bytecomp/symtable.mli b/bytecomp/symtable.mli
index e3c33d2396..ffc878bf10 100644
--- a/bytecomp/symtable.mli
+++ b/bytecomp/symtable.mli
@@ -17,7 +17,7 @@ open Cmo_format
 (* Functions for batch linking *)
 
 val init: unit -> unit
-val patch_object: string -> (reloc_info * int) list -> unit
+val patch_object: bytes -> (reloc_info * int) list -> unit
 val ls_patch_object: Misc.LongString.t -> (reloc_info * int) list -> unit
 val require_primitive: string -> unit
 val initial_global_table: unit -> Obj.t array
@@ -29,7 +29,7 @@ val data_primitive_names: unit -> string
 
 (* Functions for the toplevel *)
 
-val init_toplevel: unit -> (string * Digest.t) list
+val init_toplevel: unit -> (string * Digest.t option) list
 val update_global_table: unit -> unit
 val get_global_value: Ident.t -> Obj.t
 val is_global_defined: Ident.t -> bool
@@ -57,3 +57,5 @@ exception Error of error
 open Format
 
 val report_error: formatter -> error -> unit
+
+val reset: unit -> unit
diff --git a/bytecomp/translclass.ml b/bytecomp/translclass.ml
index 72022a5e3a..2363bd8fb6 100644
--- a/bytecomp/translclass.ml
+++ b/bytecomp/translclass.ml
@@ -145,7 +145,7 @@ let rec build_object_init cl_table obj params inh_init obj_init cl =
                | Tcf_val (_, _, id, Tcfk_concrete (_, exp), _) ->
                    (inh_init, lsequence (set_inst_var obj id exp) obj_init,
                     has_init)
-               | Tcf_method _ | Tcf_val _ | Tcf_constraint _ ->
+               | Tcf_method _ | Tcf_val _ | Tcf_constraint _ | Tcf_attribute _ ->
                    (inh_init, obj_init, has_init)
                | Tcf_initializer _ ->
                    (inh_init, obj_init, true)
@@ -305,7 +305,9 @@ let rec build_class_init cla cstr super inh_init cl_init msubst top cl =
                  Lsequence(mkappl (oo_prim "add_initializer",
                                    Lvar cla :: msubst false (transl_exp exp)),
                            cl_init),
-                 methods, values))
+                 methods, values)
+            | Tcf_attribute _ ->
+                (inh_init, cl_init, methods, values))
           str.cstr_fields
           (inh_init, cl_init, [], [])
       in
@@ -810,7 +812,7 @@ let transl_class ids cl_id pub_meths cl vflag =
 (*
     let cl_id = ci.ci_id_class in
 (* TODO: cl_id is used somewhere else as typesharp ? *)
-  let _arity = List.length (fst ci.ci_params) in
+  let _arity = List.length ci.ci_params in
   let pub_meths = m in
   let cl = ci.ci_expr in
   let vflag = vf in
diff --git a/bytecomp/translcore.ml b/bytecomp/translcore.ml
index 0df2c9ce2d..f21f8c071e 100644
--- a/bytecomp/translcore.ml
+++ b/bytecomp/translcore.ml
@@ -311,6 +311,7 @@ let primitives_table = create_hashtable 57 [
   "%bswap_int32", Pbbswap(Pint32);
   "%bswap_int64", Pbbswap(Pint64);
   "%bswap_native", Pbbswap(Pnativeint);
+  "%int_as_pointer", Pint_as_pointer;
 ]
 
 let prim_makearray =
@@ -553,7 +554,7 @@ let rec push_defaults loc bindings cases partial =
                            val_attributes = [];
                            Types.val_loc = Location.none;
                           })},
-             cases, partial) }
+             cases, [], partial) }
       in
       push_defaults loc bindings
         [{c_lhs={pat with pat_desc = Tpat_var (param, mknoloc name)};
@@ -730,12 +731,8 @@ and transl_exp0 e =
       end
   | Texp_apply(funct, oargs) ->
       event_after e (transl_apply (transl_exp funct) oargs e.exp_loc)
-  | Texp_match({exp_desc = Texp_tuple argl}, pat_expr_list, partial) ->
-      Matching.for_multiple_match e.exp_loc
-        (transl_list argl) (transl_cases pat_expr_list) partial
-  | Texp_match(arg, pat_expr_list, partial) ->
-      Matching.for_function e.exp_loc None
-        (transl_exp arg) (transl_cases pat_expr_list) partial
+  | Texp_match(arg, pat_expr_list, exn_pat_expr_list, partial) ->
+    transl_match e arg pat_expr_list exn_pat_expr_list partial
   | Texp_try(body, pat_expr_list) ->
       let id = name_pattern "exn" pat_expr_list in
       Ltrywith(transl_exp body, id,
@@ -761,10 +758,12 @@ and transl_exp0 e =
           with Not_constant ->
             Lprim(Pmakeblock(n, Immutable), ll)
           end
-      | Cstr_exception (path, _) ->
-          let slot = transl_path ~loc:e.exp_loc e.exp_env path in
-          if cstr.cstr_arity = 0 then slot
-          else Lprim(Pmakeblock(0, Immutable), slot :: ll)
+      | Cstr_extension(path, is_const) ->
+          if is_const then
+            transl_path e.exp_env path
+          else
+            Lprim(Pmakeblock(0, Immutable),
+                  transl_path e.exp_env path :: ll)
       end
   | Texp_variant(l, arg) ->
       let tag = Btype.hash_variant l in
@@ -789,7 +788,7 @@ and transl_exp0 e =
         match lbl.lbl_repres with
           Record_regular | Record_inlined _ -> Pfield lbl.lbl_pos
         | Record_float -> Pfloatfield lbl.lbl_pos
-        | Record_exception _ -> Pfield (lbl.lbl_pos + 1)
+        | Record_extension _ -> Pfield (lbl.lbl_pos + 1)
       in
       Lprim(access, [transl_exp arg])
   | Texp_setfield(arg, _, lbl, newval) ->
@@ -798,7 +797,7 @@ and transl_exp0 e =
           Record_regular
         | Record_inlined _ -> Psetfield(lbl.lbl_pos, maybe_pointer newval)
         | Record_float -> Psetfloatfield lbl.lbl_pos
-        | Record_exception _ ->
+        | Record_extension _ ->
             Psetfield (lbl.lbl_pos + 1, maybe_pointer newval)
       in
       Lprim(access, [transl_exp arg; transl_exp newval])
@@ -912,7 +911,6 @@ and transl_exp0 e =
                 || has_base_type e Predef.path_exn
                 || has_base_type e Predef.path_array
                 || has_base_type e Predef.path_list
-                || has_base_type e Predef.path_format6
                 || has_base_type e Predef.path_option
                 || has_base_type e Predef.path_nativeint
                 || has_base_type e Predef.path_int32
@@ -1099,7 +1097,7 @@ and transl_record env all_labels repres lbl_expr_list opt_init_expr =
           let access =
             match all_labels.(i).lbl_repres with
               Record_regular | Record_inlined _ -> Pfield i
-            | Record_exception _ -> Pfield (i + 1)
+            | Record_extension _ -> Pfield (i + 1)
             | Record_float -> Pfloatfield i in
           lv.(i) <- Lprim(access, [Lvar init_id])
         done
@@ -1121,14 +1119,14 @@ and transl_record env all_labels repres lbl_expr_list opt_init_expr =
         | Record_inlined tag -> Lconst(Const_block(tag, cl))
         | Record_float ->
             Lconst(Const_float_array(List.map extract_float cl))
-        | Record_exception _ ->
+        | Record_extension _ ->
             raise Not_constant
       with Not_constant ->
         match repres with
           Record_regular -> Lprim(Pmakeblock(0, mut), ll)
         | Record_inlined tag -> Lprim(Pmakeblock(tag, mut), ll)
         | Record_float -> Lprim(Pmakearray Pfloatarray, ll)
-        | Record_exception path ->
+        | Record_extension path ->
             let slot = transl_path env path in
             Lprim(Pmakeblock(0, Immutable), slot :: ll)
     in
@@ -1148,7 +1146,7 @@ and transl_record env all_labels repres lbl_expr_list opt_init_expr =
           Record_regular
         | Record_inlined _ -> Psetfield(lbl.lbl_pos, maybe_pointer expr)
         | Record_float -> Psetfloatfield lbl.lbl_pos
-        | Record_exception _ -> Psetfield(lbl.lbl_pos + 1, maybe_pointer expr)
+        | Record_extension _ -> Psetfield(lbl.lbl_pos + 1, maybe_pointer expr)
       in
       Lsequence(Lprim(upd, [Lvar copy_id; transl_exp expr]), cont) in
     begin match opt_init_expr with
@@ -1160,6 +1158,34 @@ and transl_record env all_labels repres lbl_expr_list opt_init_expr =
     end
   end
 
+and transl_match e arg pat_expr_list exn_pat_expr_list partial =
+  let id = name_pattern "exn" exn_pat_expr_list
+  and cases = transl_cases pat_expr_list
+  and exn_cases = transl_cases exn_pat_expr_list in
+  let static_catch body val_ids handler =
+    let static_exception_id = next_negative_raise_count () in
+    Lstaticcatch
+      (Ltrywith (Lstaticraise (static_exception_id, body), id,
+                 Matching.for_trywith (Lvar id) exn_cases),
+       (static_exception_id, val_ids),
+       handler)
+  in
+  match arg, exn_cases with
+  | {exp_desc = Texp_tuple argl}, [] ->
+    Matching.for_multiple_match e.exp_loc (transl_list argl) cases partial
+  | {exp_desc = Texp_tuple argl}, _ :: _ ->
+    let val_ids = List.map (fun _ -> name_pattern "val" []) argl in
+    let lvars = List.map (fun id -> Lvar id) val_ids in
+    static_catch (transl_list argl) val_ids 
+      (Matching.for_multiple_match e.exp_loc lvars cases partial)
+  | arg, [] ->
+    Matching.for_function e.exp_loc None (transl_exp arg) cases partial
+  | arg, _ :: _ ->
+    let val_id = name_pattern "val" pat_expr_list in
+    static_catch [transl_exp arg] [val_id]
+      (Matching.for_function e.exp_loc None (Lvar val_id) cases partial)
+
+
 (* Wrapper for class compilation *)
 
 (*
diff --git a/bytecomp/translmod.ml b/bytecomp/translmod.ml
index 64964e187d..01ca31caf3 100644
--- a/bytecomp/translmod.ml
+++ b/bytecomp/translmod.ml
@@ -30,23 +30,50 @@ type error =
 
 exception Error of Location.t * error
 
-(* Compile an exception definition *)
+(* Keep track of the root path (from the root of the namespace to the
+   currently compiled module expression).  Useful for naming extensions. *)
+
+let global_path glob = Some(Pident glob)
+let functor_path path param =
+  match path with
+    None -> None
+  | Some p -> Some(Papply(p, Pident param))
+let field_path path field =
+  match path with
+    None -> None
+  | Some p -> Some(Pdot(p, Ident.name field, Path.nopos))
+
+(* Compile type extensions *)
 
 let prim_set_oo_id =
   Pccall {Primitive.prim_name = "caml_set_oo_id"; prim_arity = 1;
           prim_alloc = false; prim_native_name = "";
           prim_native_float = false}
 
-let transl_exception path decl =
+let transl_extension_constructor env path ext =
   let name =
     match path with
-      None -> Ident.name decl.cd_id
+      None -> Ident.name ext.ext_id
     | Some p -> Path.name p
   in
-  Lprim(prim_set_oo_id,
-        [Lprim(Pmakeblock(Obj.object_tag, Mutable),
-              [Lconst(Const_base(Const_string (name,None)));
-               Lconst(Const_base(Const_int 0))])])
+  match ext.ext_kind with
+    Text_decl(args, ret) ->
+      Lprim(prim_set_oo_id,
+            [Lprim(Pmakeblock(Obj.object_tag, Mutable),
+                   [Lconst(Const_base(Const_string (name,None)));
+                    Lconst(Const_base(Const_int 0))])])
+  | Text_rebind(path, lid) ->
+      transl_path ~loc:ext.ext_loc env path
+
+let transl_type_extension env rootpath tyext body =
+  List.fold_right
+    (fun ext body ->
+      let lam =
+        transl_extension_constructor env (field_path rootpath ext.ext_id) ext
+      in
+      Llet(Strict, ext.ext_id, lam, body))
+    tyext.tyext_constructors
+    body
 
 (* Compile a coercion *)
 
@@ -126,19 +153,6 @@ let record_primitive = function
       primitive_declarations := p :: !primitive_declarations
   | _ -> ()
 
-(* Keep track of the root path (from the root of the namespace to the
-   currently compiled module expression).  Useful for naming exceptions. *)
-
-let global_path glob = Some(Pident glob)
-let functor_path path param =
-  match path with
-    None -> None
-  | Some p -> Some(Papply(p, Pident param))
-let field_path path field =
-  match path with
-    None -> None
-  | Some p -> Some(Pdot(p, Ident.name field, Path.nopos))
-
 (* Utilities for compiling "module rec" definitions *)
 
 let mod_prim name =
@@ -181,7 +195,7 @@ let init_shape modl =
         init_v :: init_shape_struct env rem
     | Sig_type(id, tdecl, _) :: rem ->
         init_shape_struct (Env.add_type ~check:false id tdecl env) rem
-    | Sig_exception(id, edecl) :: rem ->
+    | Sig_typext(id, ext, _) :: rem ->
         raise Not_found
     | Sig_module(id, md, _) :: rem ->
         init_shape_mod env md.md_type ::
@@ -275,14 +289,14 @@ let compile_recmodule compile_rhs bindings cont =
 
 (* Extract the list of "value" identifiers bound by a signature.
    "Value" identifiers are identifiers for signature components that
-   correspond to a run-time value: values, exceptions, modules, classes.
+   correspond to a run-time value: values, extensions, modules, classes.
    Note: manifest primitives do not correspond to a run-time value! *)
 
 let rec bound_value_identifiers = function
     [] -> []
   | Sig_value(id, {val_kind = Val_reg}) :: rem ->
       id :: bound_value_identifiers rem
-  | Sig_exception(id, decl) :: rem -> id :: bound_value_identifiers rem
+  | Sig_typext(id, ext, _) :: rem -> id :: bound_value_identifiers rem
   | Sig_module(id, mty, _) :: rem -> id :: bound_value_identifiers rem
   | Sig_class(id, decl, _) :: rem -> id :: bound_value_identifiers rem
   | _ :: rem -> bound_value_identifiers rem
@@ -363,14 +377,14 @@ and transl_structure fields cc rootpath = function
       transl_structure fields cc rootpath rem
   | Tstr_type(decls) ->
       transl_structure fields cc rootpath rem
-  | Tstr_exception decl ->
-      let id = decl.cd_id in
-      Llet(Strict, id, transl_exception (field_path rootpath id) decl,
-           transl_structure (id :: fields) cc rootpath rem)
-  | Tstr_exn_rebind er ->
-      let id = er.exrb_id in
-      let loc = er.exrb_txt.Location.loc in
-      Llet(Strict, id, transl_path ~loc item.str_env er.exrb_path,
+  | Tstr_typext(tyext) ->
+      let ids = List.map (fun ext -> ext.ext_id) tyext.tyext_constructors in
+      transl_type_extension item.str_env rootpath tyext
+        (transl_structure (List.rev_append ids fields) cc rootpath rem)
+  | Tstr_exception ext ->
+      let id = ext.ext_id in
+      let path = field_path rootpath id in
+      Llet(Strict, id, transl_extension_constructor item.str_env path ext,
            transl_structure (id :: fields) cc rootpath rem)
   | Tstr_module mb ->
       let id = mb.mb_id in
@@ -394,7 +408,7 @@ and transl_structure fields cc rootpath = function
                 let cl = ci.ci_expr in
                   (id, transl_class ids id meths cl vf ))
                 cl_list,
-              transl_structure (List.rev ids @ fields) cc rootpath rem)
+              transl_structure (List.rev_append ids fields) cc rootpath rem)
   | Tstr_include incl ->
       let ids = bound_value_identifiers incl.incl_type in
       let modl = incl.incl_mod in
@@ -447,8 +461,10 @@ let rec defined_idents = function
       let_bound_idents pat_expr_list @ defined_idents rem
     | Tstr_primitive desc -> defined_idents rem
     | Tstr_type decls -> defined_idents rem
-    | Tstr_exception decl -> decl.cd_id :: defined_idents rem
-    | Tstr_exn_rebind er -> er.exrb_id :: defined_idents rem
+    | Tstr_typext tyext ->
+      List.map (fun ext -> ext.ext_id) tyext.tyext_constructors
+      @ defined_idents rem
+    | Tstr_exception ext -> ext.ext_id :: defined_idents rem
     | Tstr_module mb -> mb.mb_id :: defined_idents rem
     | Tstr_recmodule decls ->
       List.map (fun mb -> mb.mb_id) decls @ defined_idents rem
@@ -471,8 +487,8 @@ let rec more_idents = function
     | Tstr_value(rec_flag, pat_expr_list) -> more_idents rem
     | Tstr_primitive _ -> more_idents rem
     | Tstr_type decls -> more_idents rem
+    | Tstr_typext tyext -> more_idents rem
     | Tstr_exception _ -> more_idents rem
-    | Tstr_exn_rebind _ -> more_idents rem
     | Tstr_recmodule decls -> more_idents rem
     | Tstr_modtype _ -> more_idents rem
     | Tstr_open _ -> more_idents rem
@@ -493,8 +509,10 @@ and all_idents = function
       let_bound_idents pat_expr_list @ all_idents rem
     | Tstr_primitive _ -> all_idents rem
     | Tstr_type decls -> all_idents rem
-    | Tstr_exception decl -> decl.cd_id :: all_idents rem
-    | Tstr_exn_rebind er -> er.exrb_id :: all_idents rem
+    | Tstr_typext tyext ->
+      List.map (fun ext -> ext.ext_id) tyext.tyext_constructors
+      @ all_idents rem
+    | Tstr_exception ext -> ext.ext_id :: all_idents rem
     | Tstr_recmodule decls ->
       List.map (fun mb -> mb.mb_id) decls @ all_idents rem
     | Tstr_modtype _ -> all_idents rem
@@ -550,18 +568,18 @@ let transl_store_structure glob map prims str =
       transl_store rootpath subst rem
   | Tstr_type(decls) ->
       transl_store rootpath subst rem
-  | Tstr_exception decl ->
-      let id = decl.cd_id in
-      let lam = transl_exception (field_path rootpath id) decl in
-      Lsequence(Llet(Strict, id, lam, store_ident id),
-                transl_store rootpath (add_ident false id subst) rem)
-  | Tstr_exn_rebind er ->
-      let id = er.exrb_id in
-      let loc = er.exrb_txt.Location.loc in
+  | Tstr_typext(tyext) ->
+      let ids = List.map (fun ext -> ext.ext_id) tyext.tyext_constructors in
       let lam =
-        subst_lambda subst (transl_path ~loc item.str_env er.exrb_path)
+        transl_type_extension item.str_env rootpath tyext (store_idents ids)
       in
-      Lsequence(Llet(Strict, id, lam, store_ident id),
+        Lsequence(subst_lambda subst lam,
+                  transl_store rootpath (add_idents false ids subst) rem)
+  | Tstr_exception ext ->
+      let id = ext.ext_id in
+      let path = field_path rootpath id in
+      let lam = transl_extension_constructor item.str_env path ext in
+      Lsequence(Llet(Strict, id, subst_lambda subst lam, store_ident id),
                 transl_store rootpath (add_ident false id subst) rem)
   | Tstr_module{mb_id=id; mb_expr={mod_desc = Tmod_structure str}} ->
     let lam = transl_store (field_path rootpath id) subst str.str_items in
@@ -770,12 +788,15 @@ let transl_toplevel_item item =
       let idents = let_bound_idents pat_expr_list in
       transl_let rec_flag pat_expr_list
                  (make_sequence toploop_setvalue_id idents)
-  | Tstr_exception decl ->
-      toploop_setvalue decl.cd_id (transl_exception None decl)
-  | Tstr_exn_rebind er ->
-      let id = er.exrb_id in
-      let loc = er.exrb_txt.Location.loc in
-      toploop_setvalue id (transl_path ~loc item.str_env er.exrb_path)
+  | Tstr_typext(tyext) ->
+      let idents =
+        List.map (fun ext -> ext.ext_id) tyext.tyext_constructors
+      in
+        transl_type_extension item.str_env None tyext
+          (make_sequence toploop_setvalue_id idents)
+  | Tstr_exception ext ->
+      toploop_setvalue ext.ext_id
+        (transl_extension_constructor item.str_env None ext)
   | Tstr_module {mb_id=id; mb_expr=modl} ->
       (* we need to use the unique name for the module because of issues
          with "open" (PR#1672) *)
@@ -913,3 +934,9 @@ let () =
       | _ ->
         None
     )
+
+let reset () =
+  primitive_declarations := [];
+  transl_store_subst := Ident.empty;
+  toploop_ident.Ident.flags <- 0;
+  aliased_idents := Ident.empty
diff --git a/bytecomp/translmod.mli b/bytecomp/translmod.mli
index 8e5005546f..1d84aaabd2 100644
--- a/bytecomp/translmod.mli
+++ b/bytecomp/translmod.mli
@@ -37,3 +37,5 @@ type error =
 exception Error of Location.t * error
 
 val report_error: Format.formatter -> error -> unit
+
+val reset: unit -> unit
diff --git a/bytecomp/translobj.ml b/bytecomp/translobj.ml
index 7f0d8577eb..02731ec684 100644
--- a/bytecomp/translobj.ml
+++ b/bytecomp/translobj.ml
@@ -162,3 +162,14 @@ let oo_wrap env req f x =
     wrapping := false;
     top_env := Env.empty;
     raise exn
+
+let reset () =
+  Hashtbl.clear consts;
+  cache_required := false;
+  method_cache := lambda_unit;
+  method_count := 0;
+  method_table := [];
+  wrapping := false;
+  top_env := Env.empty;
+  classes := [];
+  method_ids := IdentSet.empty
diff --git a/bytecomp/translobj.mli b/bytecomp/translobj.mli
index 55c1634332..a44ac683ff 100644
--- a/bytecomp/translobj.mli
+++ b/bytecomp/translobj.mli
@@ -26,3 +26,5 @@ val method_ids: IdentSet.t ref (* reset when starting a new wrapper *)
 
 val oo_wrap: Env.t -> bool -> ('a -> lambda) -> 'a -> lambda
 val oo_add_class: Ident.t -> Env.t * bool
+
+val reset: unit -> unit
diff --git a/byterun/.depend b/byterun/.depend
index a68ab0904e..2f1780db9e 100644
--- a/byterun/.depend
+++ b/byterun/.depend
@@ -1,419 +1,422 @@
 alloc.o: alloc.c alloc.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h custom.h major_gc.h freelist.h memory.h gc.h \
- minor_gc.h stacks.h
+  ../config/s.h mlvalues.h custom.h major_gc.h freelist.h memory.h gc.h \
+  minor_gc.h stacks.h
 array.o: array.c alloc.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h fail.h memory.h gc.h major_gc.h freelist.h \
- minor_gc.h
+  ../config/s.h mlvalues.h fail.h memory.h gc.h major_gc.h freelist.h \
+  minor_gc.h
 backtrace.o: backtrace.c config.h ../config/m.h ../config/s.h \
- compatibility.h mlvalues.h misc.h alloc.h io.h instruct.h intext.h \
- exec.h fix_code.h memory.h gc.h major_gc.h freelist.h minor_gc.h \
- startup.h stacks.h sys.h backtrace.h
+  compatibility.h mlvalues.h misc.h alloc.h io.h instruct.h intext.h \
+  exec.h fix_code.h memory.h gc.h major_gc.h freelist.h minor_gc.h \
+  startup.h stacks.h sys.h backtrace.h
 callback.o: callback.c callback.h compatibility.h mlvalues.h config.h \
- ../config/m.h ../config/s.h misc.h fail.h memory.h gc.h major_gc.h \
- freelist.h minor_gc.h interp.h instruct.h fix_code.h stacks.h
+  ../config/m.h ../config/s.h misc.h fail.h memory.h gc.h major_gc.h \
+  freelist.h minor_gc.h interp.h instruct.h fix_code.h stacks.h
 compact.o: compact.c config.h ../config/m.h ../config/s.h compatibility.h \
- finalise.h roots.h misc.h memory.h gc.h mlvalues.h major_gc.h freelist.h \
- minor_gc.h gc_ctrl.h weak.h
+  finalise.h roots.h misc.h memory.h gc.h mlvalues.h major_gc.h \
+  freelist.h minor_gc.h gc_ctrl.h weak.h
 compare.o: compare.c custom.h compatibility.h mlvalues.h config.h \
- ../config/m.h ../config/s.h misc.h fail.h memory.h gc.h major_gc.h \
- freelist.h minor_gc.h
+  ../config/m.h ../config/s.h misc.h fail.h memory.h gc.h major_gc.h \
+  freelist.h minor_gc.h
 custom.o: custom.c alloc.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h custom.h fail.h memory.h gc.h major_gc.h \
- freelist.h minor_gc.h
+  ../config/s.h mlvalues.h custom.h fail.h memory.h gc.h major_gc.h \
+  freelist.h minor_gc.h
 debugger.o: debugger.c alloc.h compatibility.h misc.h config.h \
- ../config/m.h ../config/s.h mlvalues.h debugger.h fail.h fix_code.h \
- instruct.h intext.h io.h stacks.h memory.h gc.h major_gc.h freelist.h \
- minor_gc.h sys.h
+  ../config/m.h ../config/s.h mlvalues.h debugger.h fail.h fix_code.h \
+  instruct.h intext.h io.h stacks.h memory.h gc.h major_gc.h freelist.h \
+  minor_gc.h sys.h
 dynlink.o: dynlink.c config.h ../config/m.h ../config/s.h compatibility.h \
- alloc.h misc.h mlvalues.h dynlink.h fail.h memory.h gc.h major_gc.h \
- freelist.h minor_gc.h osdeps.h prims.h
+  alloc.h misc.h mlvalues.h dynlink.h fail.h memory.h gc.h major_gc.h \
+  freelist.h minor_gc.h osdeps.h prims.h
 extern.o: extern.c alloc.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h custom.h fail.h gc.h intext.h io.h md5.h \
- memory.h major_gc.h freelist.h minor_gc.h reverse.h
+  ../config/s.h mlvalues.h custom.h fail.h gc.h intext.h io.h md5.h \
+  memory.h major_gc.h freelist.h minor_gc.h reverse.h
 fail.o: fail.c alloc.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h fail.h io.h gc.h memory.h major_gc.h freelist.h \
- minor_gc.h printexc.h signals.h stacks.h
+  ../config/s.h mlvalues.h fail.h io.h gc.h memory.h major_gc.h \
+  freelist.h minor_gc.h printexc.h signals.h stacks.h
 finalise.o: finalise.c callback.h compatibility.h mlvalues.h config.h \
- ../config/m.h ../config/s.h misc.h fail.h roots.h memory.h gc.h \
- major_gc.h freelist.h minor_gc.h signals.h
+  ../config/m.h ../config/s.h misc.h fail.h roots.h memory.h gc.h \
+  major_gc.h freelist.h minor_gc.h signals.h
 fix_code.o: fix_code.c config.h ../config/m.h ../config/s.h \
- compatibility.h debugger.h misc.h mlvalues.h fix_code.h instruct.h \
- intext.h io.h md5.h memory.h gc.h major_gc.h freelist.h minor_gc.h \
- reverse.h
+  compatibility.h debugger.h misc.h mlvalues.h fix_code.h instruct.h \
+  intext.h io.h md5.h memory.h gc.h major_gc.h freelist.h minor_gc.h \
+  reverse.h
 floats.o: floats.c alloc.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h fail.h memory.h gc.h major_gc.h freelist.h \
- minor_gc.h reverse.h stacks.h
+  ../config/s.h mlvalues.h fail.h memory.h gc.h major_gc.h freelist.h \
+  minor_gc.h reverse.h stacks.h
 freelist.o: freelist.c config.h ../config/m.h ../config/s.h \
- compatibility.h freelist.h misc.h mlvalues.h gc.h gc_ctrl.h memory.h \
- major_gc.h minor_gc.h
+  compatibility.h freelist.h misc.h mlvalues.h gc.h gc_ctrl.h memory.h \
+  major_gc.h minor_gc.h
 gc_ctrl.o: gc_ctrl.c alloc.h compatibility.h misc.h config.h \
- ../config/m.h ../config/s.h mlvalues.h compact.h custom.h finalise.h \
- roots.h memory.h gc.h major_gc.h freelist.h minor_gc.h gc_ctrl.h \
- stacks.h
+  ../config/m.h ../config/s.h mlvalues.h compact.h custom.h finalise.h \
+  roots.h memory.h gc.h major_gc.h freelist.h minor_gc.h gc_ctrl.h \
+  stacks.h
 globroots.o: globroots.c memory.h compatibility.h config.h ../config/m.h \
- ../config/s.h gc.h mlvalues.h misc.h major_gc.h freelist.h minor_gc.h \
- roots.h globroots.h
+  ../config/s.h gc.h mlvalues.h misc.h major_gc.h freelist.h minor_gc.h \
+  roots.h globroots.h
 hash.o: hash.c mlvalues.h compatibility.h config.h ../config/m.h \
- ../config/s.h misc.h custom.h memory.h gc.h major_gc.h freelist.h \
- minor_gc.h hash.h int64_native.h
+  ../config/s.h misc.h custom.h memory.h gc.h major_gc.h freelist.h \
+  minor_gc.h hash.h int64_native.h
 instrtrace.o: instrtrace.c
 intern.o: intern.c alloc.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h callback.h custom.h fail.h gc.h intext.h io.h \
- md5.h memory.h major_gc.h freelist.h minor_gc.h reverse.h
+  ../config/s.h mlvalues.h callback.h custom.h fail.h gc.h intext.h io.h \
+  md5.h memory.h major_gc.h freelist.h minor_gc.h reverse.h
 interp.o: interp.c alloc.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h backtrace.h callback.h debugger.h fail.h \
- fix_code.h instrtrace.h instruct.h interp.h major_gc.h freelist.h \
- memory.h gc.h minor_gc.h prims.h signals.h stacks.h jumptbl.h
+  ../config/s.h mlvalues.h backtrace.h callback.h debugger.h fail.h \
+  fix_code.h instrtrace.h instruct.h interp.h major_gc.h freelist.h \
+  memory.h gc.h minor_gc.h prims.h signals.h stacks.h jumptbl.h
 ints.o: ints.c alloc.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h custom.h fail.h intext.h io.h memory.h gc.h \
- major_gc.h freelist.h minor_gc.h int64_native.h
+  ../config/s.h mlvalues.h custom.h fail.h intext.h io.h memory.h gc.h \
+  major_gc.h freelist.h minor_gc.h int64_native.h
 io.o: io.c config.h ../config/m.h ../config/s.h compatibility.h alloc.h \
- misc.h mlvalues.h custom.h fail.h io.h memory.h gc.h major_gc.h \
- freelist.h minor_gc.h signals.h sys.h
+  misc.h mlvalues.h custom.h fail.h io.h memory.h gc.h major_gc.h \
+  freelist.h minor_gc.h signals.h sys.h
 lexing.o: lexing.c fail.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h stacks.h memory.h gc.h major_gc.h freelist.h \
- minor_gc.h
+  ../config/s.h mlvalues.h stacks.h memory.h gc.h major_gc.h freelist.h \
+  minor_gc.h
 main.o: main.c misc.h compatibility.h config.h ../config/m.h \
- ../config/s.h mlvalues.h sys.h
+  ../config/s.h mlvalues.h sys.h
 major_gc.o: major_gc.c compact.h config.h ../config/m.h ../config/s.h \
- compatibility.h misc.h custom.h mlvalues.h fail.h finalise.h roots.h \
- memory.h gc.h major_gc.h freelist.h minor_gc.h gc_ctrl.h weak.h
+  compatibility.h misc.h custom.h mlvalues.h fail.h finalise.h roots.h \
+  memory.h gc.h major_gc.h freelist.h minor_gc.h gc_ctrl.h weak.h
 md5.o: md5.c alloc.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h fail.h md5.h io.h memory.h gc.h major_gc.h \
- freelist.h minor_gc.h reverse.h
+  ../config/s.h mlvalues.h fail.h md5.h io.h memory.h gc.h major_gc.h \
+  freelist.h minor_gc.h reverse.h
 memory.o: memory.c fail.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h freelist.h gc.h gc_ctrl.h major_gc.h memory.h \
- minor_gc.h signals.h
+  ../config/s.h mlvalues.h freelist.h gc.h gc_ctrl.h major_gc.h memory.h \
+  minor_gc.h signals.h
 meta.o: meta.c alloc.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h fail.h fix_code.h interp.h intext.h io.h \
- major_gc.h freelist.h memory.h gc.h minor_gc.h prims.h stacks.h
+  ../config/s.h mlvalues.h fail.h fix_code.h interp.h intext.h io.h \
+  major_gc.h freelist.h memory.h gc.h minor_gc.h prims.h stacks.h
 minor_gc.o: minor_gc.c config.h ../config/m.h ../config/s.h \
- compatibility.h fail.h misc.h mlvalues.h finalise.h roots.h memory.h \
- gc.h major_gc.h freelist.h minor_gc.h gc_ctrl.h signals.h weak.h
+  compatibility.h fail.h misc.h mlvalues.h finalise.h roots.h memory.h \
+  gc.h major_gc.h freelist.h minor_gc.h gc_ctrl.h signals.h weak.h
 misc.o: misc.c config.h ../config/m.h ../config/s.h compatibility.h \
- misc.h memory.h gc.h mlvalues.h major_gc.h freelist.h minor_gc.h
+  misc.h memory.h gc.h mlvalues.h major_gc.h freelist.h minor_gc.h
 obj.o: obj.c alloc.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h fail.h gc.h interp.h major_gc.h freelist.h \
- memory.h minor_gc.h prims.h
+  ../config/s.h mlvalues.h fail.h gc.h interp.h major_gc.h freelist.h \
+  memory.h minor_gc.h prims.h
 parsing.o: parsing.c config.h ../config/m.h ../config/s.h compatibility.h \
- mlvalues.h misc.h memory.h gc.h major_gc.h freelist.h minor_gc.h alloc.h
+  mlvalues.h misc.h memory.h gc.h major_gc.h freelist.h minor_gc.h \
+  alloc.h
 prims.o: prims.c mlvalues.h compatibility.h config.h ../config/m.h \
- ../config/s.h misc.h prims.h
+  ../config/s.h misc.h prims.h
 printexc.o: printexc.c backtrace.h mlvalues.h compatibility.h config.h \
- ../config/m.h ../config/s.h misc.h callback.h debugger.h fail.h \
- printexc.h
+  ../config/m.h ../config/s.h misc.h callback.h debugger.h fail.h \
+  printexc.h
 roots.o: roots.c finalise.h roots.h misc.h compatibility.h config.h \
- ../config/m.h ../config/s.h memory.h gc.h mlvalues.h major_gc.h \
- freelist.h minor_gc.h globroots.h stacks.h
+  ../config/m.h ../config/s.h memory.h gc.h mlvalues.h major_gc.h \
+  freelist.h minor_gc.h globroots.h stacks.h
 signals.o: signals.c alloc.h compatibility.h misc.h config.h \
- ../config/m.h ../config/s.h mlvalues.h callback.h fail.h memory.h gc.h \
- major_gc.h freelist.h minor_gc.h roots.h signals.h signals_machdep.h \
- sys.h
+  ../config/m.h ../config/s.h mlvalues.h callback.h fail.h memory.h gc.h \
+  major_gc.h freelist.h minor_gc.h roots.h signals.h signals_machdep.h \
+  sys.h
 signals_byt.o: signals_byt.c config.h ../config/m.h ../config/s.h \
- compatibility.h memory.h gc.h mlvalues.h misc.h major_gc.h freelist.h \
- minor_gc.h osdeps.h signals.h signals_machdep.h
+  compatibility.h memory.h gc.h mlvalues.h misc.h major_gc.h freelist.h \
+  minor_gc.h osdeps.h signals.h signals_machdep.h
 stacks.o: stacks.c config.h ../config/m.h ../config/s.h compatibility.h \
- fail.h misc.h mlvalues.h stacks.h memory.h gc.h major_gc.h freelist.h \
- minor_gc.h
+  fail.h misc.h mlvalues.h stacks.h memory.h gc.h major_gc.h freelist.h \
+  minor_gc.h
 startup.o: startup.c config.h ../config/m.h ../config/s.h compatibility.h \
- alloc.h misc.h mlvalues.h backtrace.h callback.h custom.h debugger.h \
- dynlink.h exec.h fail.h fix_code.h freelist.h gc_ctrl.h instrtrace.h \
- interp.h intext.h io.h memory.h gc.h major_gc.h minor_gc.h osdeps.h \
- prims.h printexc.h reverse.h signals.h stacks.h sys.h startup.h \
- version.h
+  alloc.h misc.h mlvalues.h backtrace.h callback.h custom.h debugger.h \
+  dynlink.h exec.h fail.h fix_code.h freelist.h gc_ctrl.h instrtrace.h \
+  interp.h intext.h io.h memory.h gc.h major_gc.h minor_gc.h osdeps.h \
+  prims.h printexc.h reverse.h signals.h stacks.h sys.h startup.h \
+  version.h
 str.o: str.c alloc.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h fail.h int64_native.h
+  ../config/s.h mlvalues.h fail.h int64_native.h
 sys.o: sys.c config.h ../config/m.h ../config/s.h compatibility.h alloc.h \
- misc.h mlvalues.h debugger.h fail.h instruct.h osdeps.h signals.h \
- stacks.h memory.h gc.h major_gc.h freelist.h minor_gc.h sys.h
+  misc.h mlvalues.h debugger.h fail.h instruct.h osdeps.h signals.h \
+  stacks.h memory.h gc.h major_gc.h freelist.h minor_gc.h sys.h
 terminfo.o: terminfo.c config.h ../config/m.h ../config/s.h \
- compatibility.h alloc.h misc.h mlvalues.h fail.h io.h
+  compatibility.h alloc.h misc.h mlvalues.h fail.h io.h
 unix.o: unix.c config.h ../config/m.h ../config/s.h compatibility.h \
- memory.h gc.h mlvalues.h misc.h major_gc.h freelist.h minor_gc.h \
- osdeps.h
+  memory.h gc.h mlvalues.h misc.h major_gc.h freelist.h minor_gc.h \
+  osdeps.h
 weak.o: weak.c alloc.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h fail.h major_gc.h freelist.h memory.h gc.h \
- minor_gc.h
+  ../config/s.h mlvalues.h fail.h major_gc.h freelist.h memory.h gc.h \
+  minor_gc.h
 win32.o: win32.c fail.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h memory.h gc.h major_gc.h freelist.h minor_gc.h \
- osdeps.h signals.h sys.h
+  ../config/s.h mlvalues.h memory.h gc.h major_gc.h freelist.h minor_gc.h \
+  osdeps.h signals.h sys.h
 alloc.d.o: alloc.c alloc.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h custom.h major_gc.h freelist.h memory.h gc.h \
- minor_gc.h stacks.h
+  ../config/s.h mlvalues.h custom.h major_gc.h freelist.h memory.h gc.h \
+  minor_gc.h stacks.h
 array.d.o: array.c alloc.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h fail.h memory.h gc.h major_gc.h freelist.h \
- minor_gc.h
+  ../config/s.h mlvalues.h fail.h memory.h gc.h major_gc.h freelist.h \
+  minor_gc.h
 backtrace.d.o: backtrace.c config.h ../config/m.h ../config/s.h \
- compatibility.h mlvalues.h misc.h alloc.h io.h instruct.h intext.h \
- exec.h fix_code.h memory.h gc.h major_gc.h freelist.h minor_gc.h \
- startup.h stacks.h sys.h backtrace.h
+  compatibility.h mlvalues.h misc.h alloc.h io.h instruct.h intext.h \
+  exec.h fix_code.h memory.h gc.h major_gc.h freelist.h minor_gc.h \
+  startup.h stacks.h sys.h backtrace.h
 callback.d.o: callback.c callback.h compatibility.h mlvalues.h config.h \
- ../config/m.h ../config/s.h misc.h fail.h memory.h gc.h major_gc.h \
- freelist.h minor_gc.h interp.h instruct.h fix_code.h stacks.h
+  ../config/m.h ../config/s.h misc.h fail.h memory.h gc.h major_gc.h \
+  freelist.h minor_gc.h interp.h instruct.h fix_code.h stacks.h
 compact.d.o: compact.c config.h ../config/m.h ../config/s.h compatibility.h \
- finalise.h roots.h misc.h memory.h gc.h mlvalues.h major_gc.h freelist.h \
- minor_gc.h gc_ctrl.h weak.h
+  finalise.h roots.h misc.h memory.h gc.h mlvalues.h major_gc.h \
+  freelist.h minor_gc.h gc_ctrl.h weak.h
 compare.d.o: compare.c custom.h compatibility.h mlvalues.h config.h \
- ../config/m.h ../config/s.h misc.h fail.h memory.h gc.h major_gc.h \
- freelist.h minor_gc.h
+  ../config/m.h ../config/s.h misc.h fail.h memory.h gc.h major_gc.h \
+  freelist.h minor_gc.h
 custom.d.o: custom.c alloc.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h custom.h fail.h memory.h gc.h major_gc.h \
- freelist.h minor_gc.h
+  ../config/s.h mlvalues.h custom.h fail.h memory.h gc.h major_gc.h \
+  freelist.h minor_gc.h
 debugger.d.o: debugger.c alloc.h compatibility.h misc.h config.h \
- ../config/m.h ../config/s.h mlvalues.h debugger.h fail.h fix_code.h \
- instruct.h intext.h io.h stacks.h memory.h gc.h major_gc.h freelist.h \
- minor_gc.h sys.h
+  ../config/m.h ../config/s.h mlvalues.h debugger.h fail.h fix_code.h \
+  instruct.h intext.h io.h stacks.h memory.h gc.h major_gc.h freelist.h \
+  minor_gc.h sys.h
 dynlink.d.o: dynlink.c config.h ../config/m.h ../config/s.h compatibility.h \
- alloc.h misc.h mlvalues.h dynlink.h fail.h memory.h gc.h major_gc.h \
- freelist.h minor_gc.h osdeps.h prims.h
+  alloc.h misc.h mlvalues.h dynlink.h fail.h memory.h gc.h major_gc.h \
+  freelist.h minor_gc.h osdeps.h prims.h
 extern.d.o: extern.c alloc.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h custom.h fail.h gc.h intext.h io.h md5.h \
- memory.h major_gc.h freelist.h minor_gc.h reverse.h
+  ../config/s.h mlvalues.h custom.h fail.h gc.h intext.h io.h md5.h \
+  memory.h major_gc.h freelist.h minor_gc.h reverse.h
 fail.d.o: fail.c alloc.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h fail.h io.h gc.h memory.h major_gc.h freelist.h \
- minor_gc.h printexc.h signals.h stacks.h
+  ../config/s.h mlvalues.h fail.h io.h gc.h memory.h major_gc.h \
+  freelist.h minor_gc.h printexc.h signals.h stacks.h
 finalise.d.o: finalise.c callback.h compatibility.h mlvalues.h config.h \
- ../config/m.h ../config/s.h misc.h fail.h roots.h memory.h gc.h \
- major_gc.h freelist.h minor_gc.h signals.h
+  ../config/m.h ../config/s.h misc.h fail.h roots.h memory.h gc.h \
+  major_gc.h freelist.h minor_gc.h signals.h
 fix_code.d.o: fix_code.c config.h ../config/m.h ../config/s.h \
- compatibility.h debugger.h misc.h mlvalues.h fix_code.h instruct.h \
- intext.h io.h md5.h memory.h gc.h major_gc.h freelist.h minor_gc.h \
- reverse.h
+  compatibility.h debugger.h misc.h mlvalues.h fix_code.h instruct.h \
+  intext.h io.h md5.h memory.h gc.h major_gc.h freelist.h minor_gc.h \
+  reverse.h
 floats.d.o: floats.c alloc.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h fail.h memory.h gc.h major_gc.h freelist.h \
- minor_gc.h reverse.h stacks.h
+  ../config/s.h mlvalues.h fail.h memory.h gc.h major_gc.h freelist.h \
+  minor_gc.h reverse.h stacks.h
 freelist.d.o: freelist.c config.h ../config/m.h ../config/s.h \
- compatibility.h freelist.h misc.h mlvalues.h gc.h gc_ctrl.h memory.h \
- major_gc.h minor_gc.h
+  compatibility.h freelist.h misc.h mlvalues.h gc.h gc_ctrl.h memory.h \
+  major_gc.h minor_gc.h
 gc_ctrl.d.o: gc_ctrl.c alloc.h compatibility.h misc.h config.h \
- ../config/m.h ../config/s.h mlvalues.h compact.h custom.h finalise.h \
- roots.h memory.h gc.h major_gc.h freelist.h minor_gc.h gc_ctrl.h \
- stacks.h
+  ../config/m.h ../config/s.h mlvalues.h compact.h custom.h finalise.h \
+  roots.h memory.h gc.h major_gc.h freelist.h minor_gc.h gc_ctrl.h \
+  stacks.h
 globroots.d.o: globroots.c memory.h compatibility.h config.h ../config/m.h \
- ../config/s.h gc.h mlvalues.h misc.h major_gc.h freelist.h minor_gc.h \
- roots.h globroots.h
+  ../config/s.h gc.h mlvalues.h misc.h major_gc.h freelist.h minor_gc.h \
+  roots.h globroots.h
 hash.d.o: hash.c mlvalues.h compatibility.h config.h ../config/m.h \
- ../config/s.h misc.h custom.h memory.h gc.h major_gc.h freelist.h \
- minor_gc.h hash.h int64_native.h
+  ../config/s.h misc.h custom.h memory.h gc.h major_gc.h freelist.h \
+  minor_gc.h hash.h int64_native.h
 instrtrace.d.o: instrtrace.c instruct.h misc.h compatibility.h config.h \
- ../config/m.h ../config/s.h mlvalues.h opnames.h prims.h stacks.h \
- memory.h gc.h major_gc.h freelist.h minor_gc.h
+  ../config/m.h ../config/s.h mlvalues.h opnames.h prims.h stacks.h \
+  memory.h gc.h major_gc.h freelist.h minor_gc.h
 intern.d.o: intern.c alloc.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h callback.h custom.h fail.h gc.h intext.h io.h \
- md5.h memory.h major_gc.h freelist.h minor_gc.h reverse.h
+  ../config/s.h mlvalues.h callback.h custom.h fail.h gc.h intext.h io.h \
+  md5.h memory.h major_gc.h freelist.h minor_gc.h reverse.h
 interp.d.o: interp.c alloc.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h backtrace.h callback.h debugger.h fail.h \
- fix_code.h instrtrace.h instruct.h interp.h major_gc.h freelist.h \
- memory.h gc.h minor_gc.h prims.h signals.h stacks.h
+  ../config/s.h mlvalues.h backtrace.h callback.h debugger.h fail.h \
+  fix_code.h instrtrace.h instruct.h interp.h major_gc.h freelist.h \
+  memory.h gc.h minor_gc.h prims.h signals.h stacks.h
 ints.d.o: ints.c alloc.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h custom.h fail.h intext.h io.h memory.h gc.h \
- major_gc.h freelist.h minor_gc.h int64_native.h
+  ../config/s.h mlvalues.h custom.h fail.h intext.h io.h memory.h gc.h \
+  major_gc.h freelist.h minor_gc.h int64_native.h
 io.d.o: io.c config.h ../config/m.h ../config/s.h compatibility.h alloc.h \
- misc.h mlvalues.h custom.h fail.h io.h memory.h gc.h major_gc.h \
- freelist.h minor_gc.h signals.h sys.h
+  misc.h mlvalues.h custom.h fail.h io.h memory.h gc.h major_gc.h \
+  freelist.h minor_gc.h signals.h sys.h
 lexing.d.o: lexing.c fail.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h stacks.h memory.h gc.h major_gc.h freelist.h \
- minor_gc.h
+  ../config/s.h mlvalues.h stacks.h memory.h gc.h major_gc.h freelist.h \
+  minor_gc.h
 main.d.o: main.c misc.h compatibility.h config.h ../config/m.h \
- ../config/s.h mlvalues.h sys.h
+  ../config/s.h mlvalues.h sys.h
 major_gc.d.o: major_gc.c compact.h config.h ../config/m.h ../config/s.h \
- compatibility.h misc.h custom.h mlvalues.h fail.h finalise.h roots.h \
- memory.h gc.h major_gc.h freelist.h minor_gc.h gc_ctrl.h weak.h
+  compatibility.h misc.h custom.h mlvalues.h fail.h finalise.h roots.h \
+  memory.h gc.h major_gc.h freelist.h minor_gc.h gc_ctrl.h weak.h
 md5.d.o: md5.c alloc.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h fail.h md5.h io.h memory.h gc.h major_gc.h \
- freelist.h minor_gc.h reverse.h
+  ../config/s.h mlvalues.h fail.h md5.h io.h memory.h gc.h major_gc.h \
+  freelist.h minor_gc.h reverse.h
 memory.d.o: memory.c fail.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h freelist.h gc.h gc_ctrl.h major_gc.h memory.h \
- minor_gc.h signals.h
+  ../config/s.h mlvalues.h freelist.h gc.h gc_ctrl.h major_gc.h memory.h \
+  minor_gc.h signals.h
 meta.d.o: meta.c alloc.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h fail.h fix_code.h interp.h intext.h io.h \
- major_gc.h freelist.h memory.h gc.h minor_gc.h prims.h stacks.h
+  ../config/s.h mlvalues.h fail.h fix_code.h interp.h intext.h io.h \
+  major_gc.h freelist.h memory.h gc.h minor_gc.h prims.h stacks.h
 minor_gc.d.o: minor_gc.c config.h ../config/m.h ../config/s.h \
- compatibility.h fail.h misc.h mlvalues.h finalise.h roots.h memory.h \
- gc.h major_gc.h freelist.h minor_gc.h gc_ctrl.h signals.h weak.h
+  compatibility.h fail.h misc.h mlvalues.h finalise.h roots.h memory.h \
+  gc.h major_gc.h freelist.h minor_gc.h gc_ctrl.h signals.h weak.h
 misc.d.o: misc.c config.h ../config/m.h ../config/s.h compatibility.h \
- misc.h memory.h gc.h mlvalues.h major_gc.h freelist.h minor_gc.h
+  misc.h memory.h gc.h mlvalues.h major_gc.h freelist.h minor_gc.h
 obj.d.o: obj.c alloc.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h fail.h gc.h interp.h major_gc.h freelist.h \
- memory.h minor_gc.h prims.h
+  ../config/s.h mlvalues.h fail.h gc.h interp.h major_gc.h freelist.h \
+  memory.h minor_gc.h prims.h
 parsing.d.o: parsing.c config.h ../config/m.h ../config/s.h compatibility.h \
- mlvalues.h misc.h memory.h gc.h major_gc.h freelist.h minor_gc.h alloc.h
+  mlvalues.h misc.h memory.h gc.h major_gc.h freelist.h minor_gc.h \
+  alloc.h
 prims.d.o: prims.c mlvalues.h compatibility.h config.h ../config/m.h \
- ../config/s.h misc.h prims.h
+  ../config/s.h misc.h prims.h
 printexc.d.o: printexc.c backtrace.h mlvalues.h compatibility.h config.h \
- ../config/m.h ../config/s.h misc.h callback.h debugger.h fail.h \
- printexc.h
+  ../config/m.h ../config/s.h misc.h callback.h debugger.h fail.h \
+  printexc.h
 roots.d.o: roots.c finalise.h roots.h misc.h compatibility.h config.h \
- ../config/m.h ../config/s.h memory.h gc.h mlvalues.h major_gc.h \
- freelist.h minor_gc.h globroots.h stacks.h
+  ../config/m.h ../config/s.h memory.h gc.h mlvalues.h major_gc.h \
+  freelist.h minor_gc.h globroots.h stacks.h
 signals.d.o: signals.c alloc.h compatibility.h misc.h config.h \
- ../config/m.h ../config/s.h mlvalues.h callback.h fail.h memory.h gc.h \
- major_gc.h freelist.h minor_gc.h roots.h signals.h signals_machdep.h \
- sys.h
+  ../config/m.h ../config/s.h mlvalues.h callback.h fail.h memory.h gc.h \
+  major_gc.h freelist.h minor_gc.h roots.h signals.h signals_machdep.h \
+  sys.h
 signals_byt.d.o: signals_byt.c config.h ../config/m.h ../config/s.h \
- compatibility.h memory.h gc.h mlvalues.h misc.h major_gc.h freelist.h \
- minor_gc.h osdeps.h signals.h signals_machdep.h
+  compatibility.h memory.h gc.h mlvalues.h misc.h major_gc.h freelist.h \
+  minor_gc.h osdeps.h signals.h signals_machdep.h
 stacks.d.o: stacks.c config.h ../config/m.h ../config/s.h compatibility.h \
- fail.h misc.h mlvalues.h stacks.h memory.h gc.h major_gc.h freelist.h \
- minor_gc.h
+  fail.h misc.h mlvalues.h stacks.h memory.h gc.h major_gc.h freelist.h \
+  minor_gc.h
 startup.d.o: startup.c config.h ../config/m.h ../config/s.h compatibility.h \
- alloc.h misc.h mlvalues.h backtrace.h callback.h custom.h debugger.h \
- dynlink.h exec.h fail.h fix_code.h freelist.h gc_ctrl.h instrtrace.h \
- interp.h intext.h io.h memory.h gc.h major_gc.h minor_gc.h osdeps.h \
- prims.h printexc.h reverse.h signals.h stacks.h sys.h startup.h \
- version.h
+  alloc.h misc.h mlvalues.h backtrace.h callback.h custom.h debugger.h \
+  dynlink.h exec.h fail.h fix_code.h freelist.h gc_ctrl.h instrtrace.h \
+  interp.h intext.h io.h memory.h gc.h major_gc.h minor_gc.h osdeps.h \
+  prims.h printexc.h reverse.h signals.h stacks.h sys.h startup.h \
+  version.h
 str.d.o: str.c alloc.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h fail.h int64_native.h
+  ../config/s.h mlvalues.h fail.h int64_native.h
 sys.d.o: sys.c config.h ../config/m.h ../config/s.h compatibility.h alloc.h \
- misc.h mlvalues.h debugger.h fail.h instruct.h osdeps.h signals.h \
- stacks.h memory.h gc.h major_gc.h freelist.h minor_gc.h sys.h
+  misc.h mlvalues.h debugger.h fail.h instruct.h osdeps.h signals.h \
+  stacks.h memory.h gc.h major_gc.h freelist.h minor_gc.h sys.h
 terminfo.d.o: terminfo.c config.h ../config/m.h ../config/s.h \
- compatibility.h alloc.h misc.h mlvalues.h fail.h io.h
+  compatibility.h alloc.h misc.h mlvalues.h fail.h io.h
 unix.d.o: unix.c config.h ../config/m.h ../config/s.h compatibility.h \
- memory.h gc.h mlvalues.h misc.h major_gc.h freelist.h minor_gc.h \
- osdeps.h
+  memory.h gc.h mlvalues.h misc.h major_gc.h freelist.h minor_gc.h \
+  osdeps.h
 weak.d.o: weak.c alloc.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h fail.h major_gc.h freelist.h memory.h gc.h \
- minor_gc.h
+  ../config/s.h mlvalues.h fail.h major_gc.h freelist.h memory.h gc.h \
+  minor_gc.h
 win32.d.o: win32.c fail.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h memory.h gc.h major_gc.h freelist.h minor_gc.h \
- osdeps.h signals.h sys.h
+  ../config/s.h mlvalues.h memory.h gc.h major_gc.h freelist.h minor_gc.h \
+  osdeps.h signals.h sys.h
 alloc.pic.o: alloc.c alloc.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h custom.h major_gc.h freelist.h memory.h gc.h \
- minor_gc.h stacks.h
+  ../config/s.h mlvalues.h custom.h major_gc.h freelist.h memory.h gc.h \
+  minor_gc.h stacks.h
 array.pic.o: array.c alloc.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h fail.h memory.h gc.h major_gc.h freelist.h \
- minor_gc.h
+  ../config/s.h mlvalues.h fail.h memory.h gc.h major_gc.h freelist.h \
+  minor_gc.h
 backtrace.pic.o: backtrace.c config.h ../config/m.h ../config/s.h \
- compatibility.h mlvalues.h misc.h alloc.h io.h instruct.h intext.h \
- exec.h fix_code.h memory.h gc.h major_gc.h freelist.h minor_gc.h \
- startup.h stacks.h sys.h backtrace.h
+  compatibility.h mlvalues.h misc.h alloc.h io.h instruct.h intext.h \
+  exec.h fix_code.h memory.h gc.h major_gc.h freelist.h minor_gc.h \
+  startup.h stacks.h sys.h backtrace.h
 callback.pic.o: callback.c callback.h compatibility.h mlvalues.h config.h \
- ../config/m.h ../config/s.h misc.h fail.h memory.h gc.h major_gc.h \
- freelist.h minor_gc.h interp.h instruct.h fix_code.h stacks.h
+  ../config/m.h ../config/s.h misc.h fail.h memory.h gc.h major_gc.h \
+  freelist.h minor_gc.h interp.h instruct.h fix_code.h stacks.h
 compact.pic.o: compact.c config.h ../config/m.h ../config/s.h compatibility.h \
- finalise.h roots.h misc.h memory.h gc.h mlvalues.h major_gc.h freelist.h \
- minor_gc.h gc_ctrl.h weak.h
+  finalise.h roots.h misc.h memory.h gc.h mlvalues.h major_gc.h \
+  freelist.h minor_gc.h gc_ctrl.h weak.h
 compare.pic.o: compare.c custom.h compatibility.h mlvalues.h config.h \
- ../config/m.h ../config/s.h misc.h fail.h memory.h gc.h major_gc.h \
- freelist.h minor_gc.h
+  ../config/m.h ../config/s.h misc.h fail.h memory.h gc.h major_gc.h \
+  freelist.h minor_gc.h
 custom.pic.o: custom.c alloc.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h custom.h fail.h memory.h gc.h major_gc.h \
- freelist.h minor_gc.h
+  ../config/s.h mlvalues.h custom.h fail.h memory.h gc.h major_gc.h \
+  freelist.h minor_gc.h
 debugger.pic.o: debugger.c alloc.h compatibility.h misc.h config.h \
- ../config/m.h ../config/s.h mlvalues.h debugger.h fail.h fix_code.h \
- instruct.h intext.h io.h stacks.h memory.h gc.h major_gc.h freelist.h \
- minor_gc.h sys.h
+  ../config/m.h ../config/s.h mlvalues.h debugger.h fail.h fix_code.h \
+  instruct.h intext.h io.h stacks.h memory.h gc.h major_gc.h freelist.h \
+  minor_gc.h sys.h
 dynlink.pic.o: dynlink.c config.h ../config/m.h ../config/s.h compatibility.h \
- alloc.h misc.h mlvalues.h dynlink.h fail.h memory.h gc.h major_gc.h \
- freelist.h minor_gc.h osdeps.h prims.h
+  alloc.h misc.h mlvalues.h dynlink.h fail.h memory.h gc.h major_gc.h \
+  freelist.h minor_gc.h osdeps.h prims.h
 extern.pic.o: extern.c alloc.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h custom.h fail.h gc.h intext.h io.h md5.h \
- memory.h major_gc.h freelist.h minor_gc.h reverse.h
+  ../config/s.h mlvalues.h custom.h fail.h gc.h intext.h io.h md5.h \
+  memory.h major_gc.h freelist.h minor_gc.h reverse.h
 fail.pic.o: fail.c alloc.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h fail.h io.h gc.h memory.h major_gc.h freelist.h \
- minor_gc.h printexc.h signals.h stacks.h
+  ../config/s.h mlvalues.h fail.h io.h gc.h memory.h major_gc.h \
+  freelist.h minor_gc.h printexc.h signals.h stacks.h
 finalise.pic.o: finalise.c callback.h compatibility.h mlvalues.h config.h \
- ../config/m.h ../config/s.h misc.h fail.h roots.h memory.h gc.h \
- major_gc.h freelist.h minor_gc.h signals.h
+  ../config/m.h ../config/s.h misc.h fail.h roots.h memory.h gc.h \
+  major_gc.h freelist.h minor_gc.h signals.h
 fix_code.pic.o: fix_code.c config.h ../config/m.h ../config/s.h \
- compatibility.h debugger.h misc.h mlvalues.h fix_code.h instruct.h \
- intext.h io.h md5.h memory.h gc.h major_gc.h freelist.h minor_gc.h \
- reverse.h
+  compatibility.h debugger.h misc.h mlvalues.h fix_code.h instruct.h \
+  intext.h io.h md5.h memory.h gc.h major_gc.h freelist.h minor_gc.h \
+  reverse.h
 floats.pic.o: floats.c alloc.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h fail.h memory.h gc.h major_gc.h freelist.h \
- minor_gc.h reverse.h stacks.h
+  ../config/s.h mlvalues.h fail.h memory.h gc.h major_gc.h freelist.h \
+  minor_gc.h reverse.h stacks.h
 freelist.pic.o: freelist.c config.h ../config/m.h ../config/s.h \
- compatibility.h freelist.h misc.h mlvalues.h gc.h gc_ctrl.h memory.h \
- major_gc.h minor_gc.h
+  compatibility.h freelist.h misc.h mlvalues.h gc.h gc_ctrl.h memory.h \
+  major_gc.h minor_gc.h
 gc_ctrl.pic.o: gc_ctrl.c alloc.h compatibility.h misc.h config.h \
- ../config/m.h ../config/s.h mlvalues.h compact.h custom.h finalise.h \
- roots.h memory.h gc.h major_gc.h freelist.h minor_gc.h gc_ctrl.h \
- stacks.h
+  ../config/m.h ../config/s.h mlvalues.h compact.h custom.h finalise.h \
+  roots.h memory.h gc.h major_gc.h freelist.h minor_gc.h gc_ctrl.h \
+  stacks.h
 globroots.pic.o: globroots.c memory.h compatibility.h config.h ../config/m.h \
- ../config/s.h gc.h mlvalues.h misc.h major_gc.h freelist.h minor_gc.h \
- roots.h globroots.h
+  ../config/s.h gc.h mlvalues.h misc.h major_gc.h freelist.h minor_gc.h \
+  roots.h globroots.h
 hash.pic.o: hash.c mlvalues.h compatibility.h config.h ../config/m.h \
- ../config/s.h misc.h custom.h memory.h gc.h major_gc.h freelist.h \
- minor_gc.h hash.h int64_native.h
+  ../config/s.h misc.h custom.h memory.h gc.h major_gc.h freelist.h \
+  minor_gc.h hash.h int64_native.h
 instrtrace.pic.o: instrtrace.c
 intern.pic.o: intern.c alloc.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h callback.h custom.h fail.h gc.h intext.h io.h \
- md5.h memory.h major_gc.h freelist.h minor_gc.h reverse.h
+  ../config/s.h mlvalues.h callback.h custom.h fail.h gc.h intext.h io.h \
+  md5.h memory.h major_gc.h freelist.h minor_gc.h reverse.h
 interp.pic.o: interp.c alloc.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h backtrace.h callback.h debugger.h fail.h \
- fix_code.h instrtrace.h instruct.h interp.h major_gc.h freelist.h \
- memory.h gc.h minor_gc.h prims.h signals.h stacks.h jumptbl.h
+  ../config/s.h mlvalues.h backtrace.h callback.h debugger.h fail.h \
+  fix_code.h instrtrace.h instruct.h interp.h major_gc.h freelist.h \
+  memory.h gc.h minor_gc.h prims.h signals.h stacks.h jumptbl.h
 ints.pic.o: ints.c alloc.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h custom.h fail.h intext.h io.h memory.h gc.h \
- major_gc.h freelist.h minor_gc.h int64_native.h
+  ../config/s.h mlvalues.h custom.h fail.h intext.h io.h memory.h gc.h \
+  major_gc.h freelist.h minor_gc.h int64_native.h
 io.pic.o: io.c config.h ../config/m.h ../config/s.h compatibility.h alloc.h \
- misc.h mlvalues.h custom.h fail.h io.h memory.h gc.h major_gc.h \
- freelist.h minor_gc.h signals.h sys.h
+  misc.h mlvalues.h custom.h fail.h io.h memory.h gc.h major_gc.h \
+  freelist.h minor_gc.h signals.h sys.h
 lexing.pic.o: lexing.c fail.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h stacks.h memory.h gc.h major_gc.h freelist.h \
- minor_gc.h
+  ../config/s.h mlvalues.h stacks.h memory.h gc.h major_gc.h freelist.h \
+  minor_gc.h
 main.pic.o: main.c misc.h compatibility.h config.h ../config/m.h \
- ../config/s.h mlvalues.h sys.h
+  ../config/s.h mlvalues.h sys.h
 major_gc.pic.o: major_gc.c compact.h config.h ../config/m.h ../config/s.h \
- compatibility.h misc.h custom.h mlvalues.h fail.h finalise.h roots.h \
- memory.h gc.h major_gc.h freelist.h minor_gc.h gc_ctrl.h weak.h
+  compatibility.h misc.h custom.h mlvalues.h fail.h finalise.h roots.h \
+  memory.h gc.h major_gc.h freelist.h minor_gc.h gc_ctrl.h weak.h
 md5.pic.o: md5.c alloc.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h fail.h md5.h io.h memory.h gc.h major_gc.h \
- freelist.h minor_gc.h reverse.h
+  ../config/s.h mlvalues.h fail.h md5.h io.h memory.h gc.h major_gc.h \
+  freelist.h minor_gc.h reverse.h
 memory.pic.o: memory.c fail.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h freelist.h gc.h gc_ctrl.h major_gc.h memory.h \
- minor_gc.h signals.h
+  ../config/s.h mlvalues.h freelist.h gc.h gc_ctrl.h major_gc.h memory.h \
+  minor_gc.h signals.h
 meta.pic.o: meta.c alloc.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h fail.h fix_code.h interp.h intext.h io.h \
- major_gc.h freelist.h memory.h gc.h minor_gc.h prims.h stacks.h
+  ../config/s.h mlvalues.h fail.h fix_code.h interp.h intext.h io.h \
+  major_gc.h freelist.h memory.h gc.h minor_gc.h prims.h stacks.h
 minor_gc.pic.o: minor_gc.c config.h ../config/m.h ../config/s.h \
- compatibility.h fail.h misc.h mlvalues.h finalise.h roots.h memory.h \
- gc.h major_gc.h freelist.h minor_gc.h gc_ctrl.h signals.h weak.h
+  compatibility.h fail.h misc.h mlvalues.h finalise.h roots.h memory.h \
+  gc.h major_gc.h freelist.h minor_gc.h gc_ctrl.h signals.h weak.h
 misc.pic.o: misc.c config.h ../config/m.h ../config/s.h compatibility.h \
- misc.h memory.h gc.h mlvalues.h major_gc.h freelist.h minor_gc.h
+  misc.h memory.h gc.h mlvalues.h major_gc.h freelist.h minor_gc.h
 obj.pic.o: obj.c alloc.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h fail.h gc.h interp.h major_gc.h freelist.h \
- memory.h minor_gc.h prims.h
+  ../config/s.h mlvalues.h fail.h gc.h interp.h major_gc.h freelist.h \
+  memory.h minor_gc.h prims.h
 parsing.pic.o: parsing.c config.h ../config/m.h ../config/s.h compatibility.h \
- mlvalues.h misc.h memory.h gc.h major_gc.h freelist.h minor_gc.h alloc.h
+  mlvalues.h misc.h memory.h gc.h major_gc.h freelist.h minor_gc.h \
+  alloc.h
 prims.pic.o: prims.c mlvalues.h compatibility.h config.h ../config/m.h \
- ../config/s.h misc.h prims.h
+  ../config/s.h misc.h prims.h
 printexc.pic.o: printexc.c backtrace.h mlvalues.h compatibility.h config.h \
- ../config/m.h ../config/s.h misc.h callback.h debugger.h fail.h \
- printexc.h
+  ../config/m.h ../config/s.h misc.h callback.h debugger.h fail.h \
+  printexc.h
 roots.pic.o: roots.c finalise.h roots.h misc.h compatibility.h config.h \
- ../config/m.h ../config/s.h memory.h gc.h mlvalues.h major_gc.h \
- freelist.h minor_gc.h globroots.h stacks.h
+  ../config/m.h ../config/s.h memory.h gc.h mlvalues.h major_gc.h \
+  freelist.h minor_gc.h globroots.h stacks.h
 signals.pic.o: signals.c alloc.h compatibility.h misc.h config.h \
- ../config/m.h ../config/s.h mlvalues.h callback.h fail.h memory.h gc.h \
- major_gc.h freelist.h minor_gc.h roots.h signals.h signals_machdep.h \
- sys.h
+  ../config/m.h ../config/s.h mlvalues.h callback.h fail.h memory.h gc.h \
+  major_gc.h freelist.h minor_gc.h roots.h signals.h signals_machdep.h \
+  sys.h
 signals_byt.pic.o: signals_byt.c config.h ../config/m.h ../config/s.h \
- compatibility.h memory.h gc.h mlvalues.h misc.h major_gc.h freelist.h \
- minor_gc.h osdeps.h signals.h signals_machdep.h
+  compatibility.h memory.h gc.h mlvalues.h misc.h major_gc.h freelist.h \
+  minor_gc.h osdeps.h signals.h signals_machdep.h
 stacks.pic.o: stacks.c config.h ../config/m.h ../config/s.h compatibility.h \
- fail.h misc.h mlvalues.h stacks.h memory.h gc.h major_gc.h freelist.h \
- minor_gc.h
+  fail.h misc.h mlvalues.h stacks.h memory.h gc.h major_gc.h freelist.h \
+  minor_gc.h
 startup.pic.o: startup.c config.h ../config/m.h ../config/s.h compatibility.h \
- alloc.h misc.h mlvalues.h backtrace.h callback.h custom.h debugger.h \
- dynlink.h exec.h fail.h fix_code.h freelist.h gc_ctrl.h instrtrace.h \
- interp.h intext.h io.h memory.h gc.h major_gc.h minor_gc.h osdeps.h \
- prims.h printexc.h reverse.h signals.h stacks.h sys.h startup.h \
- version.h
+  alloc.h misc.h mlvalues.h backtrace.h callback.h custom.h debugger.h \
+  dynlink.h exec.h fail.h fix_code.h freelist.h gc_ctrl.h instrtrace.h \
+  interp.h intext.h io.h memory.h gc.h major_gc.h minor_gc.h osdeps.h \
+  prims.h printexc.h reverse.h signals.h stacks.h sys.h startup.h \
+  version.h
 str.pic.o: str.c alloc.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h fail.h int64_native.h
+  ../config/s.h mlvalues.h fail.h int64_native.h
 sys.pic.o: sys.c config.h ../config/m.h ../config/s.h compatibility.h alloc.h \
- misc.h mlvalues.h debugger.h fail.h instruct.h osdeps.h signals.h \
- stacks.h memory.h gc.h major_gc.h freelist.h minor_gc.h sys.h
+  misc.h mlvalues.h debugger.h fail.h instruct.h osdeps.h signals.h \
+  stacks.h memory.h gc.h major_gc.h freelist.h minor_gc.h sys.h
 terminfo.pic.o: terminfo.c config.h ../config/m.h ../config/s.h \
- compatibility.h alloc.h misc.h mlvalues.h fail.h io.h
+  compatibility.h alloc.h misc.h mlvalues.h fail.h io.h
 unix.pic.o: unix.c config.h ../config/m.h ../config/s.h compatibility.h \
- memory.h gc.h mlvalues.h misc.h major_gc.h freelist.h minor_gc.h \
- osdeps.h
+  memory.h gc.h mlvalues.h misc.h major_gc.h freelist.h minor_gc.h \
+  osdeps.h
 weak.pic.o: weak.c alloc.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h fail.h major_gc.h freelist.h memory.h gc.h \
- minor_gc.h
+  ../config/s.h mlvalues.h fail.h major_gc.h freelist.h memory.h gc.h \
+  minor_gc.h
 win32.pic.o: win32.c fail.h compatibility.h misc.h config.h ../config/m.h \
- ../config/s.h mlvalues.h memory.h gc.h major_gc.h freelist.h minor_gc.h \
- osdeps.h signals.h sys.h
+  ../config/s.h mlvalues.h memory.h gc.h major_gc.h freelist.h minor_gc.h \
+  osdeps.h signals.h sys.h
diff --git a/byterun/Makefile.common b/byterun/Makefile.common
index d2db39fe40..b6bff21948 100755
--- a/byterun/Makefile.common
+++ b/byterun/Makefile.common
@@ -32,7 +32,8 @@ PRIMS=\
 
 PUBLIC_INCLUDES=\
   alloc.h callback.h config.h custom.h fail.h hash.h intext.h \
-  memory.h misc.h mlvalues.h printexc.h signals.h compatibility.h
+  memory.h misc.h mlvalues.h printexc.h signals.h compatibility.h \
+  version.h
 
 
 all:: ocamlrun$(EXE) ld.conf libcamlrun.$(A) all-$(RUNTIMED)
@@ -117,8 +118,8 @@ jumptbl.h : instruct.h
 	sed -n -e '/^  /s/ \([A-Z]\)/ \&\&lbl_\1/gp' \
 	       -e '/^}/q' instruct.h > jumptbl.h
 
-version.h : ../VERSION
-	echo "#define OCAML_VERSION \"`sed -e 1q ../VERSION`\"" > version.h
+version.h : ../VERSION ../tools/make-version-header.sh
+	../tools/make-version-header.sh ../VERSION > version.h
 
 clean ::
 	rm -f ocamlrun$(EXE) ocamlrund$(EXE) *.$(O) *.$(A) *.$(SO)
diff --git a/byterun/alloc.c b/byterun/alloc.c
index a1fd2f03ed..1fc33b55a2 100644
--- a/byterun/alloc.c
+++ b/byterun/alloc.c
@@ -39,11 +39,13 @@ CAMLexport value caml_alloc (mlsize_t wosize, tag_t tag)
   }else if (wosize <= Max_young_wosize){
     Alloc_small (result, wosize, tag);
     if (tag < No_scan_tag){
-      for (i = 0; i < wosize; i++) Field (result, i) = 0;
+      for (i = 0; i < wosize; i++) Field (result, i) = Val_unit;
     }
   }else{
     result = caml_alloc_shr (wosize, tag);
-    if (tag < No_scan_tag) memset (Bp_val (result), 0, Bsize_wsize (wosize));
+    if (tag < No_scan_tag){
+      for (i = 0; i < wosize; i++) Field (result, i) = Val_unit;
+    }
     result = caml_check_urgent_gc (result);
   }
   return result;
diff --git a/byterun/array.c b/byterun/array.c
index 327f2b5647..ba6fd701bc 100644
--- a/byterun/array.c
+++ b/byterun/array.c
@@ -214,9 +214,13 @@ CAMLprim value caml_make_array(value init)
         || Tag_val(v) != Double_tag) {
       CAMLreturn (init);
     } else {
-      Assert(size < Max_young_wosize);
       wsize = size * Double_wosize;
-      res = caml_alloc_small(wsize, Double_array_tag);
+      if (wsize <= Max_young_wosize) {
+        res = caml_alloc_small(wsize, Double_array_tag);
+      } else {
+        res = caml_alloc_shr(wsize, Double_array_tag);
+        res = caml_check_urgent_gc(res);
+      }
       for (i = 0; i < size; i++) {
         Store_double_field(res, i, Double_val(Field(init, i)));
       }
diff --git a/byterun/backtrace.c b/byterun/backtrace.c
index d39e395290..9b8022a306 100644
--- a/byterun/backtrace.c
+++ b/byterun/backtrace.c
@@ -35,6 +35,7 @@
 #include "stacks.h"
 #include "sys.h"
 #include "backtrace.h"
+#include "fail.h"
 
 CAMLexport int caml_backtrace_active = 0;
 CAMLexport int caml_backtrace_pos = 0;
@@ -102,6 +103,7 @@ void caml_stash_backtrace(value exn, code_t pc, value * sp, int reraise)
     caml_backtrace_last_exn = exn;
   }
   if (caml_backtrace_buffer == NULL) {
+    Assert(caml_backtrace_pos == 0);
     caml_backtrace_buffer = malloc(BACKTRACE_BUFFER_SIZE * sizeof(code_t));
     if (caml_backtrace_buffer == NULL) return;
   }
@@ -119,6 +121,17 @@ void caml_stash_backtrace(value exn, code_t pc, value * sp, int reraise)
   }
 }
 
+/* In order to prevent the GC from walking through the debug
+   information (which have no headers), we transform code pointers to
+   31/63 bits ocaml integers by shifting them by 1 to the right. We do
+   not lose information as code pointers are aligned.
+
+   In particular, we do not need to use [caml_initialize] when setting
+   an array element with such a value.
+*/
+#define Val_Codet(p) Val_long((uintnat)p>>1)
+#define Codet_Val(v) ((code_t)(Long_val(v)<<1))
+
 /* returns the next frame pointer (or NULL if none is available);
    updates *sp to point to the following one, and *trapsp to the next
    trap frame, which we will skip when we reach it  */
@@ -165,7 +178,7 @@ CAMLprim value caml_get_current_callstack(value max_frames_value) {
     }
   }
 
-  trace = caml_alloc(trace_size, Abstract_tag);
+  trace = caml_alloc(trace_size, 0);
 
   /* then collect the trace */
   {
@@ -176,36 +189,52 @@ CAMLprim value caml_get_current_callstack(value max_frames_value) {
     for (trace_pos = 0; trace_pos < trace_size; trace_pos++) {
       code_t p = caml_next_frame_pointer(&sp, &trapsp);
       Assert(p != NULL);
-      /* The assignment below is safe without [caml_initialize], even
-         if the trace is large and allocated on the old heap, because
-         we assign values that are outside the OCaml heap. */
-      Assert(!(Is_block((value) p) && Is_in_heap((value) p)));
-      Field(trace, trace_pos) = (value) p;
+      Field(trace, trace_pos) = Val_Codet(p);
     }
   }
 
   CAMLreturn(trace);
 }
 
-/* Read the debugging info contained in the current bytecode executable.
-   Return an OCaml array of OCaml lists of debug_event records in "events",
-   or Val_false on failure. */
+/* Read the debugging info contained in the current bytecode executable. */
 
 #ifndef O_BINARY
 #define O_BINARY 0
 #endif
 
+struct ev_info {
+  code_t ev_pc;
+  char * ev_filename;
+  int ev_lnum;
+  int ev_startchr;
+  int ev_endchr;
+};
+
+static int cmp_ev_info(const void *a, const void *b) {
+  code_t pc_a = ((const struct ev_info*)a)->ev_pc;
+  code_t pc_b = ((const struct ev_info*)b)->ev_pc;
+  if (pc_a > pc_b) return 1;
+  if (pc_a < pc_b) return -1;
+  return 0;
+}
+
 static char *read_debug_info_error = "";
-static value read_debug_info(void)
+static uintnat n_events;
+static struct ev_info *events = NULL;
+static void read_debug_info(void)
 {
   CAMLparam0();
-  CAMLlocal1(events);
+  CAMLlocal1(events_heap);
   char * exec_name;
   int fd;
   struct exec_trailer trail;
   struct channel * chan;
   uint32 num_events, orig, i;
-  value evl, l;
+  intnat j;
+  value evl, l, ev_start;
+
+  if(events != NULL)
+    CAMLreturn0;
 
   if (caml_cds_file != NULL) {
     exec_name = caml_cds_file;
@@ -215,17 +244,18 @@ static value read_debug_info(void)
   fd = caml_attempt_open(&exec_name, &trail, 1);
   if (fd < 0){
     read_debug_info_error = "executable program file not found";
-    CAMLreturn(Val_false);
+    CAMLreturn0;
   }
   caml_read_section_descriptors(fd, &trail);
   if (caml_seek_optional_section(fd, &trail, "DBUG") == -1) {
     close(fd);
     read_debug_info_error = "program not linked with -g";
-    CAMLreturn(Val_false);
+    CAMLreturn0;
   }
   chan = caml_open_descriptor_in(fd);
   num_events = caml_getword(chan);
-  events = caml_alloc(num_events, 0);
+  n_events = 0;
+  events_heap = caml_alloc(num_events, 0);
   for (i = 0; i < num_events; i++) {
     orig = caml_getword(chan);
     evl = caml_input_val(chan);
@@ -234,36 +264,82 @@ static value read_debug_info(void)
     for (l = evl; l != Val_int(0); l = Field(l, 1)) {
       value ev = Field(l, 0);
       Field(ev, EV_POS) = Val_long(Long_val(Field(ev, EV_POS)) + orig);
+      n_events++;
     }
     /* Record event list */
-    Store_field(events, i, evl);
+    Store_field(events_heap, i, evl);
   }
   caml_close_channel(chan);
-  CAMLreturn(events);
+
+  events = (struct ev_info*)malloc(n_events * sizeof(struct ev_info));
+  if(events == NULL) {
+    read_debug_info_error = "out of memory";
+    CAMLreturn0;
+  }
+
+  j = 0;
+  for (i = 0; i < num_events; i++) {
+    for (l = Field(events_heap, i); l != Val_int(0); l = Field(l, 1)) {
+      uintnat fnsz;
+      value ev = Field(l, 0);
+
+      events[j].ev_pc =
+        (code_t)((char*)caml_start_code + Long_val(Field(ev, EV_POS)));
+
+      ev_start = Field (Field (ev, EV_LOC), LOC_START);
+
+      fnsz = caml_string_length(Field (ev_start, POS_FNAME))+1;
+      events[j].ev_filename = (char*)malloc(fnsz);
+      if(events[j].ev_filename == NULL) {
+        for(j--; j >= 0; j--)
+          free(events[j].ev_filename);
+        free(events);
+        events = NULL;
+        read_debug_info_error = "out of memory";
+        CAMLreturn0;
+      }
+      memcpy(events[j].ev_filename, String_val (Field (ev_start, POS_FNAME)), fnsz);
+
+      events[j].ev_lnum = Int_val (Field (ev_start, POS_LNUM));
+      events[j].ev_startchr =
+        Int_val (Field (ev_start, POS_CNUM))
+        - Int_val (Field (ev_start, POS_BOL));
+      events[j].ev_endchr =
+        Int_val (Field (Field (Field (ev, EV_LOC), LOC_END), POS_CNUM))
+        - Int_val (Field (ev_start, POS_BOL));
+
+      j++;
+    }
+  }
+
+  Assert(j == n_events);
+
+  qsort(events, n_events, sizeof(struct ev_info), cmp_ev_info);
+
+  CAMLreturn0;
 }
 
-/* Search the event for the given PC.  Return Val_false if not found. */
+/* Search the event index for the given PC.  Return -1 if not found. */
 
-static value event_for_location(value events, code_t pc)
+static intnat event_for_location(code_t pc)
 {
-  mlsize_t i;
-  value pos, l, ev, ev_pos, best_ev;
-
-  best_ev = 0;
+  uintnat low = 0, high = n_events;
   Assert(pc >= caml_start_code && pc < caml_start_code + caml_code_size);
-  pos = Val_long((char *) pc - (char *) caml_start_code);
-  for (i = 0; i < Wosize_val(events); i++) {
-    for (l = Field(events, i); l != Val_int(0); l = Field(l, 1)) {
-      ev = Field(l, 0);
-      ev_pos = Field(ev, EV_POS);
-      if (ev_pos == pos) return ev;
-      /* ocamlc sometimes moves an event past a following PUSH instruction;
-         allow mismatch by 1 instruction. */
-      if (ev_pos == pos + 8) best_ev = ev;
-    }
+  Assert(events != NULL);
+  while(low+1 < high) {
+    uintnat m = (low+high)/2;
+    if(pc < events[m].ev_pc) high = m;
+    else low = m;
   }
-  if (best_ev != 0) return best_ev;
-  return Val_false;
+  if(events[low].ev_pc == pc)
+    return low;
+  /* ocamlc sometimes moves an event past a following PUSH instruction;
+     allow mismatch by 1 instruction. */
+  if(events[low].ev_pc == pc + 1)
+    return low;
+  if(low+1 < n_events && events[low+1].ev_pc == pc + 1)
+    return low+1;
+  return -1;
 }
 
 /* Extract location information for the given PC */
@@ -277,28 +353,21 @@ struct loc_info {
   int loc_endchr;
 };
 
-static void extract_location_info(value events, code_t pc,
+static void extract_location_info(code_t pc,
                                   /*out*/ struct loc_info * li)
 {
-  value ev, ev_start;
-
-  ev = event_for_location(events, pc);
+  intnat ev = event_for_location(pc);
   li->loc_is_raise = caml_is_instruction(*pc, RAISE) ||
     caml_is_instruction(*pc, RERAISE);
-  if (ev == Val_false) {
+  if (ev == -1) {
     li->loc_valid = 0;
     return;
   }
   li->loc_valid = 1;
-  ev_start = Field (Field (ev, EV_LOC), LOC_START);
-  li->loc_filename = String_val (Field (ev_start, POS_FNAME));
-  li->loc_lnum = Int_val (Field (ev_start, POS_LNUM));
-  li->loc_startchr =
-    Int_val (Field (ev_start, POS_CNUM))
-    - Int_val (Field (ev_start, POS_BOL));
-  li->loc_endchr =
-    Int_val (Field (Field (Field (ev, EV_LOC), LOC_END), POS_CNUM))
-    - Int_val (Field (ev_start, POS_BOL));
+  li->loc_filename = events[ev].ev_filename;
+  li->loc_lnum = events[ev].ev_lnum;
+  li->loc_startchr = events[ev].ev_startchr;
+  li->loc_endchr = events[ev].ev_endchr;
 }
 
 /* Print location information -- same behavior as in Printexc */
@@ -335,55 +404,47 @@ static void print_location(struct loc_info * li, int index)
 
 CAMLexport void caml_print_exception_backtrace(void)
 {
-  value events;
   int i;
   struct loc_info li;
 
-  events = read_debug_info();
-  if (events == Val_false) {
+  read_debug_info();
+  if (events == NULL) {
     fprintf(stderr, "(Cannot print stack backtrace: %s)\n",
             read_debug_info_error);
     return;
   }
   for (i = 0; i < caml_backtrace_pos; i++) {
-    extract_location_info(events, caml_backtrace_buffer[i], &li);
+    extract_location_info(caml_backtrace_buffer[i], &li);
     print_location(&li, i);
   }
 }
 
 /* Convert the backtrace to a data structure usable from OCaml */
 
-CAMLprim value caml_convert_raw_backtrace(value backtrace)
-{
-  CAMLparam1(backtrace);
-  CAMLlocal5(events, res, arr, p, fname);
-  int i;
+CAMLprim value caml_convert_raw_backtrace_slot(value backtrace_slot) {
+  CAMLparam1(backtrace_slot);
+  CAMLlocal2(p, fname);
   struct loc_info li;
 
-  events = read_debug_info();
-  if (events == Val_false) {
-    res = Val_int(0);           /* None */
+  read_debug_info();
+  if (events == NULL)
+    caml_failwith(read_debug_info_error);
+
+  extract_location_info(Codet_Val(backtrace_slot), &li);
+
+  if (li.loc_valid) {
+    fname = caml_copy_string(li.loc_filename);
+    p = caml_alloc_small(5, 0);
+    Field(p, 0) = Val_bool(li.loc_is_raise);
+    Field(p, 1) = fname;
+    Field(p, 2) = Val_int(li.loc_lnum);
+    Field(p, 3) = Val_int(li.loc_startchr);
+    Field(p, 4) = Val_int(li.loc_endchr);
   } else {
-    arr = caml_alloc(Wosize_val(backtrace), 0);
-    for (i = 0; i < Wosize_val(backtrace); i++) {
-      extract_location_info(events, (code_t)Field(backtrace, i), &li);
-      if (li.loc_valid) {
-        fname = caml_copy_string(li.loc_filename);
-        p = caml_alloc_small(5, 0);
-        Field(p, 0) = Val_bool(li.loc_is_raise);
-        Field(p, 1) = fname;
-        Field(p, 2) = Val_int(li.loc_lnum);
-        Field(p, 3) = Val_int(li.loc_startchr);
-        Field(p, 4) = Val_int(li.loc_endchr);
-      } else {
-        p = caml_alloc_small(1, 1);
-        Field(p, 0) = Val_bool(li.loc_is_raise);
-      }
-      caml_modify(&Field(arr, i), p);
-    }
-    res = caml_alloc_small(1, 0); Field(res, 0) = arr; /* Some */
+    p = caml_alloc_small(1, 1);
+    Field(p, 0) = Val_bool(li.loc_is_raise);
   }
-  CAMLreturn(res);
+  CAMLreturn(p);
 }
 
 /* Get a copy of the latest backtrace */
@@ -392,20 +453,49 @@ CAMLprim value caml_get_exception_raw_backtrace(value unit)
 {
   CAMLparam0();
   CAMLlocal1(res);
-  res = caml_alloc(caml_backtrace_pos, Abstract_tag);
-  if(caml_backtrace_buffer != NULL)
-    memcpy(&Field(res, 0), caml_backtrace_buffer,
-           caml_backtrace_pos * sizeof(code_t));
+
+  res = caml_alloc(caml_backtrace_pos, 0);
+  if(caml_backtrace_buffer != NULL) {
+    intnat i;
+    for(i = 0; i < caml_backtrace_pos; i++)
+      Field(res, i) = Val_Codet(caml_backtrace_buffer[i]);
+  }
   CAMLreturn(res);
 }
 
-/* the function below is deprecated: see asmrun/backtrace.c */
+/* the function below is deprecated: we previously returned directly
+   the OCaml-usable representation, instead of the raw backtrace as an
+   abstract type, but this has a large performance overhead if you
+   store a lot of backtraces and print only some of them.
+
+   It is not used by the Printexc library anymore, or anywhere else in
+   the compiler, but we have kept it in case some user still depends
+   on it as an external.
+*/
 
 CAMLprim value caml_get_exception_backtrace(value unit)
 {
   CAMLparam0();
-  CAMLlocal2(raw, res);
-  raw = caml_get_exception_raw_backtrace(unit);
-  res = caml_convert_raw_backtrace(raw);
+  CAMLlocal4(arr, raw_slot, slot, res);
+
+  read_debug_info();
+  if (events == NULL) {
+      res = Val_int(0); /* None */
+  } else {
+      arr = caml_alloc(caml_backtrace_pos, 0);
+      if(caml_backtrace_buffer == NULL) {
+          Assert(caml_backtrace_pos == 0);
+      } else {
+          intnat i;
+          for(i = 0; i < caml_backtrace_pos; i++) {
+              raw_slot = Val_Codet(caml_backtrace_buffer[i]);
+              /* caml_convert_raw_backtrace_slot will not fail with
+               caml_failwith as we checked (events != NULL) already */
+              slot = caml_convert_raw_backtrace_slot(raw_slot);
+              caml_modify(&Field(arr, i), slot);
+          }
+      }
+      res = caml_alloc_small(1, 0); Field(res, 0) = arr; /* Some */
+  }
   CAMLreturn(res);
 }
diff --git a/byterun/extern.c b/byterun/extern.c
index 33fa89a913..deb8209bad 100644
--- a/byterun/extern.c
+++ b/byterun/extern.c
@@ -75,10 +75,10 @@ static struct extern_item * extern_stack_limit = extern_stack_init
 
 /* Forward declarations */
 
-static void extern_out_of_memory(void);
-static void extern_invalid_argument(char *msg);
-static void extern_failwith(char *msg);
-static void extern_stack_overflow(void);
+static void extern_out_of_memory(void) Noreturn;
+static void extern_invalid_argument(char *msg) Noreturn;
+static void extern_failwith(char *msg) Noreturn;
+static void extern_stack_overflow(void) Noreturn;
 static struct code_fragment * extern_find_code(char *addr);
 static void extern_replay_trail(void);
 static void free_extern_output(void);
diff --git a/byterun/fail.c b/byterun/fail.c
index 530ca5d138..148e47a994 100644
--- a/byterun/fail.c
+++ b/byterun/fail.c
@@ -71,11 +71,9 @@ CAMLexport void caml_raise_with_args(value tag, int nargs, value args[])
 
 CAMLexport void caml_raise_with_string(value tag, char const *msg)
 {
-  CAMLparam1 (tag);
-  CAMLlocal1 (vmsg);
-
-  vmsg = caml_copy_string(msg);
-  caml_raise_with_arg(tag, vmsg);
+  CAMLparam1(tag);
+  value v_msg = caml_copy_string(msg);
+  caml_raise_with_arg(tag, v_msg);
   CAMLnoreturn;
 }
 
diff --git a/byterun/fix_code.c b/byterun/fix_code.c
index 746f8b7500..3380dc9195 100644
--- a/byterun/fix_code.c
+++ b/byterun/fix_code.c
@@ -98,10 +98,10 @@ char * caml_instr_base;
 void caml_thread_code (code_t code, asize_t len)
 {
   code_t p;
-  int l [STOP + 1];
+  int l [FIRST_UNIMPLEMENTED_OP];
   int i;
 
-  for (i = 0; i <= STOP; i++) {
+  for (i = 0; i < FIRST_UNIMPLEMENTED_OP; i++) {
     l [i] = 0;
   }
   /* Instructions with one operand */
@@ -125,7 +125,7 @@ void caml_thread_code (code_t code, asize_t len)
   len /= sizeof(opcode_t);
   for (p = code; p < code + len; /*nothing*/) {
     opcode_t instr = *p;
-    if (instr < 0 || instr > STOP){
+    if (instr < 0 || instr >= FIRST_UNIMPLEMENTED_OP){
       /* FIXME -- should Assert(false) ?
       caml_fatal_error_arg ("Fatal error in fix_code: bad opcode (%lx)\n",
                             (char *)(long)instr);
diff --git a/byterun/hash.c b/byterun/hash.c
index 3beb0e016e..f8964265db 100644
--- a/byterun/hash.c
+++ b/byterun/hash.c
@@ -172,6 +172,8 @@ CAMLexport uint32 caml_hash_mix_string(uint32 h, value s)
 
 /* Maximal size of the queue used for breadth-first traversal.  */
 #define HASH_QUEUE_SIZE 256
+/* Maximal number of Forward_tag links followed in one step */
+#define MAX_FORWARD_DEREFERENCE 1000
 
 /* The generic hash function */
 
@@ -213,7 +215,7 @@ CAMLprim value caml_hash(value count, value limit, value seed, value obj)
         for (i = 0, len = Wosize_val(v) / Double_wosize; i < len; i++) {
           h = caml_hash_mix_double(h, Double_field(v, i));
           num--;
-          if (num < 0) break;
+          if (num <= 0) break;
         }
         break;
       case Abstract_tag:
@@ -226,8 +228,15 @@ CAMLprim value caml_hash(value count, value limit, value seed, value obj)
         v = v - Infix_offset_val(v);
         goto again;
       case Forward_tag:
-        v = Forward_val(v);
-        goto again;
+        /* PR#6361: we can have a loop here, so limit the number of
+           Forward_tag links being followed */
+        for (i = MAX_FORWARD_DEREFERENCE; i > 0; i--) {
+          v = Forward_val(v);
+          if (Is_long(v) || !Is_in_value_area(v) || Tag_val(v) != Forward_tag)
+            goto again;
+        }
+        /* Give up on this object and move to the next */
+        break;
       case Object_tag:
         h = caml_hash_mix_intnat(h, Oid_val(v));
         num--;
diff --git a/byterun/instruct.h b/byterun/instruct.h
index a643b0f935..f9cc80ee65 100644
--- a/byterun/instruct.h
+++ b/byterun/instruct.h
@@ -40,7 +40,6 @@ enum instructions {
   GETSTRINGCHAR, SETSTRINGCHAR,
   BRANCH, BRANCHIF, BRANCHIFNOT, SWITCH, BOOLNOT,
   PUSHTRAP, POPTRAP, RAISE,
-  RERAISE, RAISE_NOTRACE,
   CHECK_SIGNALS,
   C_CALL1, C_CALL2, C_CALL3, C_CALL4, C_CALL5, C_CALLN,
   CONST0, CONST1, CONST2, CONST3, CONSTINT,
@@ -55,7 +54,9 @@ enum instructions {
   BULTINT, BUGEINT,
   GETPUBMET, GETDYNMET,
   STOP,
-  EVENT, BREAK
-};
+  EVENT, BREAK,
+  RERAISE, RAISE_NOTRACE,
+FIRST_UNIMPLEMENTED_OP};
+
 
 #endif /* CAML_INSTRUCT_H */
diff --git a/byterun/interp.c b/byterun/interp.c
index a0e54d166a..9b682ba6ea 100644
--- a/byterun/interp.c
+++ b/byterun/interp.c
@@ -523,10 +523,21 @@ value caml_interprete(code_t prog, asize_t prog_size)
       int nvars = *pc++;
       int i;
       if (nvars > 0) *--sp = accu;
-      Alloc_small(accu, 1 + nvars, Closure_tag);
+      if (nvars < Max_young_wosize) {
+        /* nvars + 1 <= Max_young_wosize, can allocate in minor heap */
+        Alloc_small(accu, 1 + nvars, Closure_tag);
+        for (i = 0; i < nvars; i++) Field(accu, i + 1) = sp[i];
+      } else {
+        /* PR#6385: must allocate in major heap */
+        /* caml_alloc_shr and caml_initialize never trigger a GC,
+           so no need to Setup_for_gc */
+        accu = caml_alloc_shr(1 + nvars, Closure_tag);
+        for (i = 0; i < nvars; i++) caml_initialize(&Field(accu, i + 1), sp[i]);
+      }
+      /* The code pointer is not in the heap, so no need to go through
+         caml_initialize. */
       Code_val(accu) = pc + *pc;
       pc++;
-      for (i = 0; i < nvars; i++) Field(accu, i + 1) = sp[i];
       sp += nvars;
       Next;
     }
@@ -534,15 +545,25 @@ value caml_interprete(code_t prog, asize_t prog_size)
     Instruct(CLOSUREREC): {
       int nfuncs = *pc++;
       int nvars = *pc++;
+      mlsize_t blksize = nfuncs * 2 - 1 + nvars;
       int i;
       value * p;
       if (nvars > 0) *--sp = accu;
-      Alloc_small(accu, nfuncs * 2 - 1 + nvars, Closure_tag);
-      p = &Field(accu, nfuncs * 2 - 1);
-      for (i = 0; i < nvars; i++) {
-        *p++ = sp[i];
+      if (blksize <= Max_young_wosize) {
+        Alloc_small(accu, blksize, Closure_tag);
+        p = &Field(accu, nfuncs * 2 - 1);
+        for (i = 0; i < nvars; i++, p++) *p = sp[i];
+      } else {
+        /* PR#6385: must allocate in major heap */
+        /* caml_alloc_shr and caml_initialize never trigger a GC,
+           so no need to Setup_for_gc */
+        accu = caml_alloc_shr(blksize, Closure_tag);
+        p = &Field(accu, nfuncs * 2 - 1);
+        for (i = 0; i < nvars; i++, p++) caml_initialize(p, sp[i]);
       }
       sp += nvars;
+      /* The code pointers and infix headers are not in the heap,
+         so no need to go through caml_initialize. */
       p = &Field(accu, 0);
       *p = (value) (pc + pc[0]);
       *--sp = accu;
diff --git a/byterun/major_gc.c b/byterun/major_gc.c
index b3c25b8172..a44c8d90ad 100644
--- a/byterun/major_gc.c
+++ b/byterun/major_gc.c
@@ -27,6 +27,12 @@
 #include "roots.h"
 #include "weak.h"
 
+#if defined (NATIVE_CODE) && defined (NO_NAKED_POINTERS)
+#define NATIVE_CODE_AND_NO_NAKED_POINTERS
+#else
+#undef NATIVE_CODE_AND_NO_NAKED_POINTERS
+#endif
+
 uintnat caml_percent_free;
 uintnat caml_major_heap_increment;
 CAMLexport char *caml_heap_start;
@@ -82,7 +88,18 @@ static void realloc_gray_vals (void)
 
 void caml_darken (value v, value *p /* not used */)
 {
+#ifdef NATIVE_CODE_AND_NO_NAKED_POINTERS
+  if (Is_block (v) && Wosize_val (v) > 0) {
+    /* We insist that naked pointers to outside the heap point to things that
+       look like values with headers coloured black.  This isn't always
+       strictly necessary but is essential in certain cases---in particular
+       when the value is allocated in a read-only section.  (For the values
+       where it would be safe it is a performance improvement since we avoid
+       putting them on the grey list.) */
+    CAMLassert (Is_in_heap (v) || Is_black_hd (Hd_val (v)));
+#else
   if (Is_block (v) && Is_in_heap (v)) {
+#endif
     header_t h = Hd_val (v);
     tag_t t = Tag_hd (h);
     if (t == Infix_tag){
@@ -124,6 +141,9 @@ static void mark_slice (intnat work)
   value v, child;
   header_t hd;
   mlsize_t size, i;
+#ifdef NATIVE_CODE_AND_NO_NAKED_POINTERS
+  int marking_closure = 0;
+#endif
 
   caml_gc_message (0x40, "Marking %ld words\n", work);
   caml_gc_message (0x40, "Subphase = %ld\n", caml_gc_subphase);
@@ -132,13 +152,28 @@ static void mark_slice (intnat work)
     if (gray_vals_ptr > gray_vals){
       v = *--gray_vals_ptr;
       hd = Hd_val(v);
+#ifdef NATIVE_CODE_AND_NO_NAKED_POINTERS
+      marking_closure =
+        (Tag_hd (hd) == Closure_tag || Tag_hd (hd) == Infix_tag);
+#endif
       Assert (Is_gray_hd (hd));
       Hd_val (v) = Blackhd_hd (hd);
       size = Wosize_hd (hd);
       if (Tag_hd (hd) < No_scan_tag){
         for (i = 0; i < size; i++){
           child = Field (v, i);
+#ifdef NATIVE_CODE_AND_NO_NAKED_POINTERS
+          if (Is_block (child)
+                && Wosize_val (child) > 0  /* Atoms never need to be marked. */
+                /* Closure blocks contain code pointers at offsets that cannot
+                   be reliably determined, so we always use the page table when
+                   marking such values. */
+                && (!marking_closure || Is_in_heap (child))) {
+            /* See [caml_darken] for a description of this assertion. */
+            CAMLassert (Is_in_heap (child) || Is_black_hd (Hd_val (child)));
+#else
           if (Is_block (child) && Is_in_heap (child)) {
+#endif
             hd = Hd_val (child);
             if (Tag_hd (hd) == Forward_tag){
               value f = Forward_val (child);
diff --git a/byterun/memory.h b/byterun/memory.h
index 0761070177..9befa873c1 100644
--- a/byterun/memory.h
+++ b/byterun/memory.h
@@ -266,27 +266,31 @@ CAMLextern struct caml__roots_block *caml_local_roots;  /* defined in roots.c */
     0)
 
 #define CAMLlocal1(x) \
-  value x = 0; \
+  value x = Val_unit; \
   CAMLxparam1 (x)
 
 #define CAMLlocal2(x, y) \
-  value x = 0, y = 0; \
+  value x = Val_unit, y = Val_unit; \
   CAMLxparam2 (x, y)
 
 #define CAMLlocal3(x, y, z) \
-  value x = 0, y = 0, z = 0; \
+  value x = Val_unit, y = Val_unit, z = Val_unit; \
   CAMLxparam3 (x, y, z)
 
 #define CAMLlocal4(x, y, z, t) \
-  value x = 0, y = 0, z = 0, t = 0; \
+  value x = Val_unit, y = Val_unit, z = Val_unit, t = Val_unit; \
   CAMLxparam4 (x, y, z, t)
 
 #define CAMLlocal5(x, y, z, t, u) \
-  value x = 0, y = 0, z = 0, t = 0, u = 0; \
+  value x = Val_unit, y = Val_unit, z = Val_unit, t = Val_unit, u = Val_unit; \
   CAMLxparam5 (x, y, z, t, u)
 
 #define CAMLlocalN(x, size) \
-  value x [(size)] = { 0, /* 0, 0, ... */ }; \
+  value x [(size)]; \
+  int caml__i_##x; \
+  for (caml__i_##x = 0; caml__i_##x < size; caml__i_##x ++) { \
+    x[caml__i_##x] = Val_unit; \
+  } \
   CAMLxparamN (x, (size))
 
 
diff --git a/byterun/misc.c b/byterun/misc.c
index 6dc27d5cc3..1872a80acd 100644
--- a/byterun/misc.c
+++ b/byterun/misc.c
@@ -26,7 +26,6 @@ int caml_failed_assert (char * expr, char * file, int line)
            file, line, expr);
   fflush (stderr);
   exit (100);
-  return 1; /* not reached */
 }
 
 void caml_set_fields (char *bp, unsigned long start, unsigned long filler)
diff --git a/byterun/misc.h b/byterun/misc.h
index 5640980a6f..f7b4fdc24a 100644
--- a/byterun/misc.h
+++ b/byterun/misc.h
@@ -64,7 +64,7 @@ typedef char * addr;
 #ifdef DEBUG
 #define CAMLassert(x) \
   ((x) ? (void) 0 : caml_failed_assert ( #x , __FILE__, __LINE__))
-CAMLextern int caml_failed_assert (char *, char *, int);
+CAMLextern int caml_failed_assert (char *, char *, int) Noreturn;
 #else
 #define CAMLassert(x) ((void) 0)
 #endif
diff --git a/byterun/obj.c b/byterun/obj.c
index 1d7b57910b..b045fee263 100644
--- a/byterun/obj.c
+++ b/byterun/obj.c
@@ -255,3 +255,7 @@ CAMLprim value caml_set_oo_id (value obj) {
   oo_last_id += 2;
   return obj;
 }
+
+CAMLprim value caml_int_as_pointer (value n) {
+  return n - 1;
+}
diff --git a/byterun/startup.c b/byterun/startup.c
index 89e296a720..3697220664 100644
--- a/byterun/startup.c
+++ b/byterun/startup.c
@@ -246,10 +246,10 @@ static int parse_command_line(char **argv)
 #endif
     case 'v':
       if (!strcmp (argv[i], "-version")){
-        printf ("The OCaml runtime, version " OCAML_VERSION "\n");
+        printf ("The OCaml runtime, version " OCAML_VERSION_STRING "\n");
         exit (0);
       }else if (!strcmp (argv[i], "-vnum")){
-        printf (OCAML_VERSION "\n");
+        printf (OCAML_VERSION_STRING "\n");
         exit (0);
       }else{
         caml_verb_gc = 0x001+0x004+0x008+0x010+0x020;
diff --git a/configure b/configure
index f2d312d558..74d489f10a 100755
--- a/configure
+++ b/configure
@@ -43,6 +43,7 @@ with_debugger=ocamldebugger
 with_ocamldoc=ocamldoc
 with_ocamlbuild=ocamlbuild
 with_frame_pointers=false
+no_naked_pointers=false
 TOOLPREF=""
 with_cfi=true
 
@@ -150,6 +151,8 @@ while : ; do
         with_ocamlbuild="";;
     -with-frame-pointers|--with-frame-pointers)
         with_frame_pointers=true;;
+    -no-naked-pointers|--no-naked-pointers)
+        no_naked_pointers=true;;
     -no-cfi|--no-cfi)
         with_cfi=false;;
     *) err "Unknown option \"$1\".";;
@@ -757,11 +760,11 @@ if test $with_sharedlibs = "yes"; then
     sparc*-*-linux*)              natdynlink=true;;
     i686-*-kfreebsd*)             natdynlink=true;;
     x86_64-*-kfreebsd*)           natdynlink=true;;
-    i[345]86-*-freebsd*)          natdynlink=true;;
+    i[3456]86-*-freebsd*)         natdynlink=true;;
     x86_64-*-freebsd*)            natdynlink=true;;
-    i[345]86-*-openbsd*)          natdynlink=true;;
+    i[3456]86-*-openbsd*)         natdynlink=true;;
     x86_64-*-openbsd*)            natdynlink=true;;
-    i[345]86-*-netbsd*)           natdynlink=true;;
+    i[3456]86-*-netbsd*)          natdynlink=true;;
     x86_64-*-netbsd*)             natdynlink=true;;
     i386-*-gnu0.3)                natdynlink=true;;
     arm*-*-linux*)                natdynlink=true;;
@@ -818,6 +821,8 @@ case "$target" in
   armv5te*-*-linux-gnueabi)     arch=arm; model=armv5te; system=linux_eabi;;
   armv5*-*-linux-gnueabi)       arch=arm; model=armv5; system=linux_eabi;;
   arm*-*-linux-gnueabi)         arch=arm; system=linux_eabi;;
+  arm*-*-openbsd*)              arch=arm; system=bsd;;
+  zaurus*-*-openbsd*)           arch=arm; system=bsd;;
   x86_64-*-linux*)              arch=amd64; system=linux;;
   x86_64-*-gnu*)                arch=amd64; system=gnu;;
   x86_64-*-freebsd*)            arch=amd64; system=freebsd;;
@@ -886,8 +891,10 @@ case "$arch,$system" in
   sparc,solaris)  as="${TOOLPREF}as"
                   case "$cc" in
                     *gcc*) aspp="${TOOLPREF}gcc -c";;
-                              *) aspp="${TOOLPREF}as -P";;
+                    *) aspp="${TOOLPREF}as -P";;
                   esac;;
+  *,freebsd)      as="${TOOLPREF}as"
+                  aspp="${TOOLPREF}cc -c";;
   amd64,*|arm,*|arm64,*|i386,*|power,bsd*|sparc,*)
                   as="${TOOLPREF}as"
                   aspp="${TOOLPREF}gcc -c";;
@@ -903,12 +910,16 @@ case "$arch,$system" in
   i386,bsd_elf) profiling='prof';;
   amd64,macosx) profiling='prof';;
   i386,macosx) profiling='prof';;
+  sparc,bsd) profiling='prof';;
   sparc,solaris)
     profiling='prof'
     case "$nativecc" in gcc*) ;; *) cc_profile='-xpg';; esac;;
   amd64,linux) profiling='prof';;
+  amd64,openbsd) profiling='prof';;
   amd64,gnu) profiling='prof';;
   arm,linux*) profiling='prof';;
+  power,elf) profiling='prof';;
+  power,bsd*) profiling='prof';;
   *) profiling='noprof';;
 esac
 
@@ -1289,6 +1300,11 @@ if test $nargs != "none"; then
   echo "#define HAS_GETHOSTBYADDR_R $nargs" >> s.h
 fi
 
+if sh ./hasgot mkstemp; then
+  inf "mkstemp() found"
+  echo "#define HAS_MKSTEMP" >> s.h
+fi
+
 # Determine if the debugger is supported
 
 if test -n "$with_debugger"; then
@@ -1600,6 +1616,9 @@ if test "$with_frame_pointers" = "true"; then
 
 fi
 
+if $no_naked_pointers; then
+  echo "#define NO_NAKED_POINTERS" >> m.h
+fi
 
 # Final twiddling of compiler options to work around known bugs
 
@@ -1736,7 +1755,11 @@ else
   else
   inf "        with frame pointers....... no"
   fi
-  echo "        native dynlink ........... $natdynlink"
+  if $no_naked_pointers; then
+  inf "        naked pointers forbidden.. yes"
+  else
+  inf "        naked pointers forbidden.. no"
+  fi
   inf "        native dynlink ........... $natdynlink"
   if test "$profiling" = "prof"; then
   inf "        profiling with gprof ..... supported"
diff --git a/debugger/.depend b/debugger/.depend
index 13de8ede13..b62541619a 100644
--- a/debugger/.depend
+++ b/debugger/.depend
@@ -164,11 +164,13 @@ program_loading.cmx : unix_tools.cmx $(UNIXDIR)/unix.cmx \
 program_management.cmo : unix_tools.cmi $(UNIXDIR)/unix.cmi \
     time_travel.cmi symbols.cmi question.cmi program_loading.cmi \
     primitives.cmi parameters.cmi int64ops.cmi input_handling.cmi history.cmi \
-    debugger_config.cmi breakpoints.cmi program_management.cmi
+    ../typing/envaux.cmi debugger_config.cmi ../utils/config.cmi \
+    breakpoints.cmi program_management.cmi
 program_management.cmx : unix_tools.cmx $(UNIXDIR)/unix.cmx \
     time_travel.cmx symbols.cmx question.cmx program_loading.cmx \
     primitives.cmx parameters.cmx int64ops.cmx input_handling.cmx history.cmx \
-    debugger_config.cmx breakpoints.cmx program_management.cmi
+    ../typing/envaux.cmx debugger_config.cmx ../utils/config.cmx \
+    breakpoints.cmx program_management.cmi
 question.cmo : primitives.cmi lexer.cmi input_handling.cmi question.cmi
 question.cmx : primitives.cmx lexer.cmx input_handling.cmx question.cmi
 show_information.cmo : symbols.cmi source.cmi show_source.cmi printval.cmi \
diff --git a/debugger/Makefile.shared b/debugger/Makefile.shared
index 249e8b4c40..fed1d26dab 100644
--- a/debugger/Makefile.shared
+++ b/debugger/Makefile.shared
@@ -14,7 +14,7 @@ include ../config/Makefile
 
 ROOTDIR=..
 CAMLC=$(ROOTDIR)/boot/ocamlrun $(ROOTDIR)/ocamlc -nostdlib -I $(ROOTDIR)/stdlib
-COMPFLAGS=-warn-error A $(INCLUDES)
+COMPFLAGS=-warn-error A -safe-string $(INCLUDES)
 LINKFLAGS=-linkall -I $(UNIXDIR)
 CAMLYACC=../boot/ocamlyacc
 YACCFLAGS=
diff --git a/debugger/debugcom.ml b/debugger/debugcom.ml
index 72702da168..ac91df799f 100644
--- a/debugger/debugcom.ml
+++ b/debugger/debugcom.ml
@@ -187,10 +187,10 @@ let set_trap_barrier pos =
 let value_size = if 1 lsl 31 = 0 then 4 else 8
 
 let input_remote_value ic =
-  Misc.input_bytes ic value_size
+  really_input_string ic value_size
 
 let output_remote_value ic v =
-  output ic v 0 value_size
+  output_substring ic v 0 value_size
 
 exception Marshalling_error
 
@@ -244,7 +244,7 @@ module Remote_value =
           if input_byte !conn.io_in = 0 then
             Remote(input_remote_value !conn.io_in)
           else begin
-            let buf = Misc.input_bytes !conn.io_in 8 in
+            let buf = really_input_string !conn.io_in 8 in
             let floatbuf = float n (* force allocation of a new float *) in
             String.unsafe_blit buf 0 (Obj.magic floatbuf) 0 8;
             Local(Obj.repr floatbuf)
diff --git a/debugger/input_handling.mli b/debugger/input_handling.mli
index 749687ce3b..66db47f15f 100644
--- a/debugger/input_handling.mli
+++ b/debugger/input_handling.mli
@@ -49,7 +49,7 @@ val current_prompt : string ref
 (* Where the user input come from. *)
 val user_channel : io_channel ref
 
-val read_user_input : string -> int -> int
+val read_user_input : bytes -> int -> int
 
 (* Stop reading user input. *)
 val stop_user_input : unit -> unit
diff --git a/debugger/program_management.ml b/debugger/program_management.ml
index 1e29b138f8..48118573ee 100644
--- a/debugger/program_management.ml
+++ b/debugger/program_management.ml
@@ -30,7 +30,7 @@ open Time_travel
 let file_name = ref (None : string option)
 
 (* Default connection handler. *)
-let buffer = String.create 1024
+let buffer = Bytes.create 1024
 let control_connection pid fd =
   if (read fd.io_fd buffer 0 1024) = 0 then
     forget_process fd pid
diff --git a/debugger/source.ml b/debugger/source.ml
index c68df3373c..af69fbc7bf 100644
--- a/debugger/source.ml
+++ b/debugger/source.ml
@@ -74,7 +74,7 @@ let get_buffer pos mdle =
   try List.assoc mdle !buffer_list with
     Not_found ->
       let inchan = open_in_bin (source_of_module pos mdle) in
-      let content = Misc.input_bytes inchan (in_channel_length inchan) in
+      let content = really_input_string inchan (in_channel_length inchan) in
       let buffer = (content, ref []) in
       buffer_list :=
         (list_truncate !buffer_max_count ((mdle, buffer)::!buffer_list));
diff --git a/driver/compenv.ml b/driver/compenv.ml
index a40083275b..32ecb937e9 100644
--- a/driver/compenv.ml
+++ b/driver/compenv.ml
@@ -55,7 +55,7 @@ let last_ppx = ref []
 let first_objfiles = ref []
 let last_objfiles = ref []
 
-(* Note: this function is duplicated in optcompile.ml *)
+(* Check validity of module name *)
 let check_unit_name ppf filename name =
   try
     begin match name.[0] with
@@ -76,10 +76,19 @@ let check_unit_name ppf filename name =
   with Exit -> ()
 ;;
 
-
-
-
-
+(* Compute name of module from output file name *)
+let module_of_filename ppf inputfile outputprefix =
+  let basename = Filename.basename outputprefix in
+  let name =
+    try
+      let pos = String.index basename '.' in
+      String.sub basename 0 pos
+    with Not_found -> basename
+  in
+  let name = String.capitalize name in
+  check_unit_name ppf inputfile name;
+  name
+;;
 
 
 type readenv_position =
@@ -158,6 +167,7 @@ let read_OCAMLPARAM ppf position =
       | "nolabels" -> set "nolabels" [ classic ] v
       | "principal" -> set "principal"  [ principal ] v
       | "rectypes" -> set "rectypes" [ recursive_types ] v
+      | "safe-string" -> clear "safe-string" [ unsafe_string ] v
       | "strict-sequence" -> set "strict-sequence" [ strict_sequence ] v
       | "thread" -> set "thread" [ use_threads ] v
       | "unsafe" -> set "unsafe" [ fast ] v
diff --git a/driver/compenv.mli b/driver/compenv.mli
index d1d64393ac..85d588ef6e 100644
--- a/driver/compenv.mli
+++ b/driver/compenv.mli
@@ -10,7 +10,8 @@
 (*                                                                     *)
 (***********************************************************************)
 
-val check_unit_name : Format.formatter -> string -> string -> unit
+(* val check_unit_name : Format.formatter -> string -> string -> unit *)
+val module_of_filename : Format.formatter -> string -> string -> string
 
 val output_prefix : string -> string
 val extract_output : string option -> string
diff --git a/driver/compile.ml b/driver/compile.ml
index bc9201e266..fb003c7ea1 100644
--- a/driver/compile.ml
+++ b/driver/compile.ml
@@ -21,17 +21,17 @@ open Compenv
 
 (* Keep in sync with the copy in optcompile.ml *)
 
+let tool_name = "ocamlc"
+
 let interface ppf sourcefile outputprefix =
   Compmisc.init_path false;
-  let modulename =
-    String.capitalize(Filename.basename(chop_extension_if_any sourcefile)) in
-  check_unit_name ppf sourcefile modulename;
+  let modulename = module_of_filename ppf sourcefile outputprefix in
   Env.set_unit_name modulename;
   let initial_env = Compmisc.initial_env () in
-  let ast = Pparse.parse_interface ppf sourcefile in
+  let ast = Pparse.parse_interface ~tool_name ppf sourcefile in
   if !Clflags.dump_parsetree then fprintf ppf "%a@." Printast.interface ast;
   if !Clflags.dump_source then fprintf ppf "%a@." Pprintast.signature ast;
-  let tsg = Typemod.transl_signature initial_env ast in
+  let tsg = Typemod.type_interface initial_env ast in
   if !Clflags.dump_typedtree then fprintf ppf "%a@." Printtyped.interface tsg;
   let sg = tsg.sig_type in
   if !Clflags.print_types then
@@ -57,9 +57,7 @@ let (++) x f = f x
 
 let implementation ppf sourcefile outputprefix =
   Compmisc.init_path false;
-  let modulename =
-    String.capitalize(Filename.basename(chop_extension_if_any sourcefile)) in
-  check_unit_name ppf sourcefile modulename;
+  let modulename = module_of_filename ppf sourcefile outputprefix in
   Env.set_unit_name modulename;
   let env = Compmisc.initial_env() in
   if !Clflags.print_types then begin
@@ -74,7 +72,7 @@ let implementation ppf sourcefile outputprefix =
       Warnings.check_fatal ();
       Stypes.dump (Some (outputprefix ^ ".annot"))
     in
-    try comp (Pparse.parse_implementation ppf sourcefile)
+    try comp (Pparse.parse_implementation ~tool_name ppf sourcefile)
     with x ->
       Stypes.dump (Some (outputprefix ^ ".annot"));
       raise x
@@ -99,7 +97,7 @@ let implementation ppf sourcefile outputprefix =
       close_out oc;
       Stypes.dump (Some (outputprefix ^ ".annot"))
     in
-    try comp (Pparse.parse_implementation ppf sourcefile)
+    try comp (Pparse.parse_implementation ~tool_name ppf sourcefile)
     with x ->
       close_out oc;
       remove_file objfile;
diff --git a/driver/compmisc.ml b/driver/compmisc.ml
index 8f974f4be1..a2bc4b83a5 100644
--- a/driver/compmisc.ml
+++ b/driver/compmisc.ml
@@ -40,19 +40,21 @@ let init_path native =
    toplevel initialization (PR#1775) *)
 
 let open_implicit_module m env =
-  try
-    Env.open_pers_signature m env
-  with Not_found ->
-    Misc.fatal_error (Printf.sprintf "cannot open implicit module %S" m)
+  let open Asttypes in
+  let lid = {loc = Location.in_file "command line";
+             txt = Longident.Lident m } in
+  snd (Typemod.type_open_ Override env lid.loc lid)
 
 let initial_env () =
   Ident.reinit();
+  let initial =
+    if !Clflags.unsafe_string then Env.initial_unsafe_string
+    else Env.initial_safe_string
+  in
   let env =
-    if !Clflags.nopervasives
-    then Env.initial
-    else
-      open_implicit_module "Pervasives" Env.initial
+    if !Clflags.nopervasives then initial else
+    open_implicit_module "Pervasives" initial
   in
   List.fold_left (fun env m ->
     open_implicit_module m env
-  ) env !implicit_modules
+  ) env (!implicit_modules @ List.rev !Clflags.open_modules)
diff --git a/driver/main.ml b/driver/main.ml
index cbb6459993..4b1c7264aa 100644
--- a/driver/main.ml
+++ b/driver/main.ml
@@ -85,6 +85,7 @@ module Options = Main_args.Make_bytecomp_options (struct
   let _custom = set custom_runtime
   let _dllib s = dllibs := Misc.rev_split_words s @ !dllibs
   let _dllpath s = dllpaths := !dllpaths @ [s]
+  let _for_pack s = for_package := Some s
   let _g = set debug
   let _i () = print_types := true; compile_only := true
   let _I s = include_dirs := s :: !include_dirs
@@ -96,12 +97,14 @@ module Options = Main_args.Make_bytecomp_options (struct
   let _linkall = set link_everything
   let _make_runtime () =
     custom_runtime := true; make_runtime := true; link_everything := true
+  let _no_alias_deps = set transparent_modules
   let _no_app_funct = unset applicative_functors
   let _noassert = set noassert
   let _nolabels = set classic
   let _noautolink = set no_auto_link
   let _nostdlib = set no_std_include
   let _o s = output_name := Some s
+  let _open s = open_modules := s :: !open_modules
   let _output_obj () = output_c_object := true; custom_runtime := true
   let _pack = set make_package
   let _pp s = preprocessor := Some s
@@ -109,12 +112,13 @@ module Options = Main_args.Make_bytecomp_options (struct
   let _principal = set principal
   let _rectypes = set recursive_types
   let _runtime_variant s = runtime_variant := s
+  let _safe_string = unset unsafe_string
   let _short_paths = unset real_paths
   let _strict_sequence = set strict_sequence
   let _thread = set use_threads
-  let _trans_mod = set transparent_modules
   let _vmthread = set use_vmthreads
   let _unsafe = set fast
+  let _unsafe_string = set unsafe_string
   let _use_prims s = use_prims := s
   let _use_runtime s = use_runtime := s
   let _v () = print_version_and_library "compiler"
@@ -160,7 +164,8 @@ let main () =
       Compmisc.init_path false;
       let extracted_output = extract_output !output_name in
       let revd = get_objfiles () in
-      Bytepackager.package_files ppf revd (extracted_output);
+      Bytepackager.package_files ppf (Compmisc.initial_env ())
+        revd (extracted_output);
       Warnings.check_fatal ();
     end
     else if not !compile_only && !objfiles <> [] then begin
diff --git a/driver/main_args.ml b/driver/main_args.ml
index ec97d6c983..dd04352ea3 100644
--- a/driver/main_args.ml
+++ b/driver/main_args.ml
@@ -73,9 +73,10 @@ let mk_dtypes f =
   "-dtypes", Arg.Unit f, " (deprecated) same as -annot"
 ;;
 
-let mk_for_pack_byt () =
-  "-for-pack", Arg.String ignore,
-  "<ident>  Ignored (for compatibility with ocamlopt)"
+let mk_for_pack_byt f =
+  "-for-pack", Arg.String f,
+  "<ident>  Generate code that can later be `packed' with\n\
+  \     ocamlc -pack -o <ident>.cmo"
 ;;
 
 let mk_for_pack_opt f =
@@ -150,10 +151,19 @@ let mk_modern f =
   "-modern", Arg.Unit f, " (deprecated) same as -labels"
 ;;
 
+let mk_no_alias_deps f =
+  "-no-alias-deps", Arg.Unit f,
+  " Do not record dependencies for module aliases"
+;;
+
 let mk_no_app_funct f =
   "-no-app-funct", Arg.Unit f, " Deactivate applicative functors"
 ;;
 
+let mk_no_float_const_prop f =
+  "-no-float-const-prop", Arg.Unit f, " Deactivate constant propagation for floating-point operations"
+;;
+
 let mk_noassert f =
   "-noassert", Arg.Unit f, " Do not compile assertion checks"
 ;;
@@ -199,6 +209,9 @@ let mk_o f =
   "-o", Arg.String f, "<file>  Set output file name to <file>"
 ;;
 
+let mk_open f =
+  "-open", Arg.String f, "<module>  Opens the module <module> before typing"
+
 let mk_output_obj f =
   "-output-obj", Arg.Unit f, " Output a C object file instead of an executable"
 ;;
@@ -243,6 +256,14 @@ let mk_S f =
   "-S", Arg.Unit f, " Keep intermediate assembly file"
 ;;
 
+let mk_safe_string f =
+  "-safe-string", Arg.Unit f, " Make strings immutable"
+;;
+
+let mk_shared f =
+  "-shared", Arg.Unit f, " Produce a dynlinkable plugin"
+;;
+
 let mk_short_paths f =
   "-short-paths", Arg.Unit f, " Shorten paths in types"
 ;;
@@ -256,24 +277,20 @@ let mk_strict_sequence f =
   " Left-hand part of a sequence must have type unit"
 ;;
 
-let mk_shared f =
-  "-shared", Arg.Unit f, " Produce a dynlinkable plugin"
-;;
-
 let mk_thread f =
   "-thread", Arg.Unit f,
   " Generate code that supports the system threads library"
 ;;
 
-let mk_trans_mod f =
-  "-trans-mod", Arg.Unit f,
-  " Make typing and linking only depend on normalized paths"
-
 let mk_unsafe f =
   "-unsafe", Arg.Unit f,
   " Do not compile bounds checking on array and string access"
 ;;
 
+let mk_unsafe_string f =
+  "-unsafe-string", Arg.Unit f, " Make strings mutable (default)"
+;;
+
 let mk_use_runtime f =
   "-use-runtime", Arg.String f,
   "<file>  Generate bytecode for the given runtime system"
@@ -385,6 +402,10 @@ let mk_dcombine f =
   "-dcombine", Arg.Unit f, " (undocumented)"
 ;;
 
+let mk_dcse f =
+  "-dcse", Arg.Unit f, " (undocumented)"
+;;
+
 let mk_dlive f =
   "-dlive", Arg.Unit f, " (undocumented)"
 ;;
@@ -430,222 +451,111 @@ let mk__ f =
   "<file>  Treat <file> as a file name (even if it starts with `-')"
 ;;
 
-module type Bytecomp_options = sig
-  val _a : unit -> unit
+module type Common_options = sig
   val _absname : unit -> unit
-  val _annot : unit -> unit
-  val _binannot : unit -> unit
-  val _c : unit -> unit
-  val _cc : string -> unit
-  val _cclib : string -> unit
-  val _ccopt : string -> unit
-  val _compat_32 : unit -> unit
-  val _config : unit -> unit
-  val _custom : unit -> unit
-  val _dllib : string -> unit
-  val _dllpath : string -> unit
-  val _g : unit -> unit
-  val _i : unit -> unit
   val _I : string -> unit
-  val _impl : string -> unit
-  val _intf : string -> unit
-  val _intf_suffix : string -> unit
-  val _keep_locs : unit -> unit
   val _labels : unit -> unit
-  val _linkall : unit -> unit
-  val _make_runtime : unit -> unit
+  val _no_alias_deps : unit -> unit
   val _no_app_funct : unit -> unit
   val _noassert : unit -> unit
-  val _noautolink : unit -> unit
   val _nolabels : unit -> unit
   val _nostdlib : unit -> unit
-  val _o : string -> unit
-  val _output_obj : unit -> unit
-  val _pack : unit -> unit
-  val _pp : string -> unit
+  val _open : string -> unit
   val _ppx : string -> unit
   val _principal : unit -> unit
   val _rectypes : unit -> unit
-  val _runtime_variant : string -> unit
+  val _safe_string : unit -> unit
   val _short_paths : unit -> unit
   val _strict_sequence : unit -> unit
-  val _trans_mod : unit -> unit
-  val _thread : unit -> unit
-  val _vmthread : unit -> unit
   val _unsafe : unit -> unit
-  val _use_runtime : string -> unit
-  val _v : unit -> unit
+  val _unsafe_string : unit -> unit
   val _version : unit -> unit
   val _vnum : unit -> unit
-  val _verbose : unit -> unit
   val _w : string -> unit
   val _warn_error : string -> unit
   val _warn_help : unit -> unit
-  val _where : unit -> unit
 
-  val _nopervasives : unit -> unit
-  val _use_prims : string -> unit
   val _dsource : unit -> unit
   val _dparsetree : unit -> unit
   val _dtypedtree : unit -> unit
   val _drawlambda : unit -> unit
   val _dlambda : unit -> unit
-  val _dinstr : unit -> unit
 
   val anonymous : string -> unit
 end;;
 
-module type Bytetop_options = sig
-  val _absname : unit -> unit
-  val _I : string -> unit
-  val _init : string -> unit
-  val _labels : unit -> unit
-  val _no_app_funct : unit -> unit
-  val _noassert : unit -> unit
-  val _noinit : unit -> unit
-  val _nolabels : unit -> unit
-  val _noprompt : unit -> unit
-  val _nopromptcont : unit -> unit
-  val _nostdlib : unit -> unit
-  val _ppx : string -> unit
-  val _principal : unit -> unit
-  val _rectypes : unit -> unit
-  val _short_paths : unit -> unit
-  val _stdin: unit -> unit
-  val _strict_sequence : unit -> unit
-  val _trans_mod : unit -> unit
-  val _unsafe : unit -> unit
-  val _version : unit -> unit
-  val _vnum : unit -> unit
-  val _w : string -> unit
-  val _warn_error : string -> unit
-  val _warn_help : unit -> unit
-
-  val _dsource : unit -> unit
-  val _dparsetree : unit -> unit
-  val _dtypedtree : unit -> unit
-  val _drawlambda : unit -> unit
-  val _dlambda : unit -> unit
-  val _dinstr : unit -> unit
-
-  val anonymous : string -> unit
-end;;
-
-module type Optcomp_options = sig
+module type Compiler_options =  sig
   val _a : unit -> unit
-  val _absname : unit -> unit
   val _annot : unit -> unit
   val _binannot : unit -> unit
   val _c : unit -> unit
   val _cc : string -> unit
   val _cclib : string -> unit
   val _ccopt : string -> unit
-  val _compact : unit -> unit
   val _config : unit -> unit
   val _for_pack : string -> unit
   val _g : unit -> unit
   val _i : unit -> unit
-  val _I : string -> unit
   val _impl : string -> unit
-  val _inline : int -> unit
   val _intf : string -> unit
   val _intf_suffix : string -> unit
   val _keep_locs : unit -> unit
-  val _labels : unit -> unit
   val _linkall : unit -> unit
-  val _no_app_funct : unit -> unit
-  val _noassert : unit -> unit
   val _noautolink : unit -> unit
-  val _nodynlink : unit -> unit
-  val _nolabels : unit -> unit
-  val _nostdlib : unit -> unit
   val _o : string -> unit
   val _output_obj : unit -> unit
-  val _p : unit -> unit
   val _pack : unit -> unit
   val _pp : string -> unit
-  val _ppx : string -> unit
   val _principal : unit -> unit
   val _rectypes : unit -> unit
   val _runtime_variant : string -> unit
-  val _S : unit -> unit
-  val _shared : unit -> unit
+  val _safe_string : unit -> unit
   val _short_paths : unit -> unit
-  val _strict_sequence : unit -> unit
-  val _trans_mod : unit -> unit
   val _thread : unit -> unit
-  val _unsafe : unit -> unit
   val _v : unit -> unit
   val _verbose : unit -> unit
-  val _version : unit -> unit
-  val _vnum : unit -> unit
-  val _w : string -> unit
-  val _warn_error : string -> unit
-  val _warn_help : unit -> unit
   val _where : unit -> unit
 
   val _nopervasives : unit -> unit
-  val _dsource : unit -> unit
-  val _dparsetree : unit -> unit
-  val _dtypedtree : unit -> unit
-  val _drawlambda : unit -> unit
-  val _dlambda : unit -> unit
-  val _dclambda : unit -> unit
-  val _dcmm : unit -> unit
-  val _dsel : unit -> unit
-  val _dcombine : unit -> unit
-  val _dlive : unit -> unit
-  val _dspill : unit -> unit
-  val _dsplit : unit -> unit
-  val _dinterf : unit -> unit
-  val _dprefer : unit -> unit
-  val _dalloc : unit -> unit
-  val _dreload : unit -> unit
-  val _dscheduling :  unit -> unit
-  val _dlinear :  unit -> unit
-  val _dstartup :  unit -> unit
+end
+;;
 
-  val anonymous : string -> unit
+module type Bytecomp_options = sig
+  include Common_options
+  include Compiler_options
+  val _compat_32 : unit -> unit
+  val _custom : unit -> unit
+  val _dllib : string -> unit
+  val _dllpath : string -> unit
+  val _make_runtime : unit -> unit
+  val _vmthread : unit -> unit
+  val _use_runtime : string -> unit
+
+  val _dinstr : unit -> unit
+
+  val _use_prims : string -> unit
 end;;
 
-module type Opttop_options = sig
-  val _absname : unit -> unit
-  val _compact : unit -> unit
-  val _I : string -> unit
+module type Bytetop_options = sig
+  include Common_options
   val _init : string -> unit
-  val _inline : int -> unit
-  val _labels : unit -> unit
-  val _no_app_funct : unit -> unit
-  val _noassert : unit -> unit
   val _noinit : unit -> unit
-  val _nolabels : unit -> unit
   val _noprompt : unit -> unit
   val _nopromptcont : unit -> unit
-  val _nostdlib : unit -> unit
-  val _ppx : string -> unit
-  val _principal : unit -> unit
-  val _rectypes : unit -> unit
-  val _S : unit -> unit
-  val _short_paths : unit -> unit
   val _stdin : unit -> unit
-  val _strict_sequence : unit -> unit
-  val _trans_mod : unit -> unit
-  val _unsafe : unit -> unit
-  val _version : unit -> unit
-  val _vnum : unit -> unit
-  val _w : string -> unit
-  val _warn_error : string -> unit
-  val _warn_help : unit -> unit
 
-  val _dsource : unit -> unit
-  val _dparsetree : unit -> unit
-  val _dtypedtree : unit -> unit
-  val _drawlambda : unit -> unit
-  val _dlambda : unit -> unit
+  val _dinstr : unit -> unit
+end;;
+
+module type Optcommon_options = sig
+  val _compact : unit -> unit
+  val _inline : int -> unit
+
   val _dclambda : unit -> unit
   val _dcmm : unit -> unit
   val _dsel : unit -> unit
   val _dcombine : unit -> unit
+  val _dcse : unit -> unit
   val _dlive : unit -> unit
   val _dspill : unit -> unit
   val _dsplit : unit -> unit
@@ -656,8 +566,29 @@ module type Opttop_options = sig
   val _dscheduling :  unit -> unit
   val _dlinear :  unit -> unit
   val _dstartup :  unit -> unit
+end;;
 
-  val anonymous : string -> unit
+module type Optcomp_options = sig
+  include Common_options
+  include Compiler_options
+  include Optcommon_options
+  val _no_float_const_prop : unit -> unit
+  val _nodynlink : unit -> unit
+  val _p : unit -> unit
+  val _pp : string -> unit
+  val _S : unit -> unit
+  val _shared : unit -> unit
+end;;
+
+module type Opttop_options = sig
+  include Common_options
+  include Optcommon_options
+  val _init : string -> unit
+  val _noinit : unit -> unit
+  val _noprompt : unit -> unit
+  val _nopromptcont : unit -> unit
+  val _S : unit -> unit
+  val _stdin : unit -> unit
 end;;
 
 module type Arg_list = sig
@@ -681,7 +612,7 @@ struct
     mk_dllib F._dllib;
     mk_dllpath F._dllpath;
     mk_dtypes F._annot;
-    mk_for_pack_byt ();
+    mk_for_pack_byt F._for_pack;
     mk_g_byt F._g;
     mk_i F._i;
     mk_I F._I;
@@ -695,12 +626,14 @@ struct
     mk_make_runtime F._make_runtime;
     mk_make_runtime_2 F._make_runtime;
     mk_modern F._labels;
+    mk_no_alias_deps F._no_alias_deps;
     mk_no_app_funct F._no_app_funct;
     mk_noassert F._noassert;
     mk_noautolink_byt F._noautolink;
     mk_nolabels F._nolabels;
     mk_nostdlib F._nostdlib;
     mk_o F._o;
+    mk_open F._open;
     mk_output_obj F._output_obj;
     mk_pack_byt F._pack;
     mk_pp F._pp;
@@ -708,11 +641,12 @@ struct
     mk_principal F._principal;
     mk_rectypes F._rectypes;
     mk_runtime_variant F._runtime_variant;
+    mk_safe_string F._safe_string;
     mk_short_paths F._short_paths;
     mk_strict_sequence F._strict_sequence;
-    mk_trans_mod F._trans_mod;
     mk_thread F._thread;
     mk_unsafe F._unsafe;
+    mk_unsafe_string F._unsafe_string;
     mk_use_runtime F._use_runtime;
     mk_use_runtime_2 F._use_runtime;
     mk_v F._v;
@@ -744,6 +678,7 @@ struct
     mk_I F._I;
     mk_init F._init;
     mk_labels F._labels;
+    mk_no_alias_deps F._no_alias_deps;
     mk_no_app_funct F._no_app_funct;
     mk_noassert F._noassert;
     mk_noinit F._noinit;
@@ -751,14 +686,16 @@ struct
     mk_noprompt F._noprompt;
     mk_nopromptcont F._nopromptcont;
     mk_nostdlib F._nostdlib;
+    mk_open F._open;
     mk_ppx F._ppx;
     mk_principal F._principal;
     mk_rectypes F._rectypes;
+    mk_safe_string F._safe_string;
     mk_short_paths F._short_paths;
     mk_stdin F._stdin;
     mk_strict_sequence F._strict_sequence;
-    mk_trans_mod F._trans_mod;
     mk_unsafe F._unsafe;
+    mk_unsafe_string F._unsafe_string;
     mk_version F._version;
     mk_vnum F._vnum;
     mk_w F._w;
@@ -800,13 +737,16 @@ struct
     mk_keep_locs F._keep_locs;
     mk_labels F._labels;
     mk_linkall F._linkall;
+    mk_no_alias_deps F._no_alias_deps;
     mk_no_app_funct F._no_app_funct;
+    mk_no_float_const_prop F._no_float_const_prop;
     mk_noassert F._noassert;
     mk_noautolink_opt F._noautolink;
     mk_nodynlink F._nodynlink;
     mk_nolabels F._nolabels;
     mk_nostdlib F._nostdlib;
     mk_o F._o;
+    mk_open F._open;
     mk_output_obj F._output_obj;
     mk_p F._p;
     mk_pack_opt F._pack;
@@ -816,12 +756,13 @@ struct
     mk_rectypes F._rectypes;
     mk_runtime_variant F._runtime_variant;
     mk_S F._S;
+    mk_safe_string F._safe_string;
     mk_shared F._shared;
     mk_short_paths F._short_paths;
     mk_strict_sequence F._strict_sequence;
-    mk_trans_mod F._trans_mod;
     mk_thread F._thread;
     mk_unsafe F._unsafe;
+    mk_unsafe_string F._unsafe_string;
     mk_v F._v;
     mk_verbose F._verbose;
     mk_version F._version;
@@ -842,6 +783,7 @@ struct
     mk_dcmm F._dcmm;
     mk_dsel F._dsel;
     mk_dcombine F._dcombine;
+    mk_dcse F._dcse;
     mk_dlive F._dlive;
     mk_dspill F._dspill;
     mk_dsplit F._dsplit;
@@ -863,6 +805,7 @@ module Make_opttop_options (F : Opttop_options) = struct
     mk_init F._init;
     mk_inline F._inline;
     mk_labels F._labels;
+    mk_no_alias_deps F._no_alias_deps;
     mk_no_app_funct F._no_app_funct;
     mk_noassert F._noassert;
     mk_noinit F._noinit;
@@ -870,15 +813,17 @@ module Make_opttop_options (F : Opttop_options) = struct
     mk_noprompt F._noprompt;
     mk_nopromptcont F._nopromptcont;
     mk_nostdlib F._nostdlib;
+    mk_open F._open;
     mk_ppx F._ppx;
     mk_principal F._principal;
     mk_rectypes F._rectypes;
     mk_S F._S;
+    mk_safe_string F._safe_string;
     mk_short_paths F._short_paths;
     mk_stdin F._stdin;
     mk_strict_sequence F._strict_sequence;
-    mk_trans_mod F._trans_mod;
     mk_unsafe F._unsafe;
+    mk_unsafe_string F._unsafe_string;
     mk_version F._version;
     mk_vnum F._vnum;
     mk_w F._w;
@@ -894,6 +839,7 @@ module Make_opttop_options (F : Opttop_options) = struct
     mk_dcmm F._dcmm;
     mk_dsel F._dsel;
     mk_dcombine F._dcombine;
+    mk_dcse F._dcse;
     mk_dlive F._dlive;
     mk_dspill F._dspill;
     mk_dsplit F._dsplit;
diff --git a/driver/main_args.mli b/driver/main_args.mli
index 67a6c681d2..e4a9c58f5e 100644
--- a/driver/main_args.mli
+++ b/driver/main_args.mli
@@ -10,93 +10,24 @@
 (*                                                                     *)
 (***********************************************************************)
 
-module type Bytecomp_options =
-  sig
-    val _a : unit -> unit
-    val _absname : unit -> unit
-    val _annot : unit -> unit
-    val _binannot : unit -> unit
-    val _c : unit -> unit
-    val _cc : string -> unit
-    val _cclib : string -> unit
-    val _ccopt : string -> unit
-    val _compat_32 : unit -> unit
-    val _config : unit -> unit
-    val _custom : unit -> unit
-    val _dllib : string -> unit
-    val _dllpath : string -> unit
-    val _g : unit -> unit
-    val _i : unit -> unit
-    val _I : string -> unit
-    val _impl : string -> unit
-    val _intf : string -> unit
-    val _intf_suffix : string -> unit
-    val _keep_locs : unit -> unit
-    val _labels : unit -> unit
-    val _linkall : unit -> unit
-    val _make_runtime : unit -> unit
-    val _no_app_funct : unit -> unit
-    val _noassert : unit -> unit
-    val _noautolink : unit -> unit
-    val _nolabels : unit -> unit
-    val _nostdlib : unit -> unit
-    val _o : string -> unit
-    val _output_obj : unit -> unit
-    val _pack : unit -> unit
-    val _pp : string -> unit
-    val _ppx : string -> unit
-    val _principal : unit -> unit
-    val _rectypes : unit -> unit
-    val _runtime_variant : string -> unit
-    val _short_paths : unit -> unit
-    val _strict_sequence : unit -> unit
-    val _trans_mod : unit -> unit
-    val _thread : unit -> unit
-    val _vmthread : unit -> unit
-    val _unsafe : unit -> unit
-    val _use_runtime : string -> unit
-    val _v : unit -> unit
-    val _version : unit -> unit
-    val _vnum : unit -> unit
-    val _verbose : unit -> unit
-    val _w : string -> unit
-    val _warn_error : string -> unit
-    val _warn_help : unit -> unit
-    val _where : unit -> unit
-
-    val _nopervasives : unit -> unit
-    val _use_prims : string -> unit
-    val _dsource : unit -> unit
-    val _dparsetree : unit -> unit
-    val _dtypedtree : unit -> unit
-    val _drawlambda : unit -> unit
-    val _dlambda : unit -> unit
-    val _dinstr : unit -> unit
-
-    val anonymous : string -> unit
-  end
-;;
-
-module type Bytetop_options = sig
+module type Common_options = sig
   val _absname : unit -> unit
   val _I : string -> unit
-  val _init : string -> unit
   val _labels : unit -> unit
+  val _no_alias_deps : unit -> unit
   val _no_app_funct : unit -> unit
   val _noassert : unit -> unit
-  val _noinit : unit -> unit
   val _nolabels : unit -> unit
-  val _noprompt : unit -> unit
-  val _nopromptcont : unit -> unit
   val _nostdlib : unit -> unit
+  val _open : string -> unit
   val _ppx : string -> unit
   val _principal : unit -> unit
   val _rectypes : unit -> unit
+  val _safe_string : unit -> unit
   val _short_paths : unit -> unit
-  val _stdin : unit -> unit
   val _strict_sequence : unit -> unit
-  val _trans_mod : unit -> unit
   val _unsafe : unit -> unit
+  val _unsafe_string : unit -> unit
   val _version : unit -> unit
   val _vnum : unit -> unit
   val _w : string -> unit
@@ -108,126 +39,82 @@ module type Bytetop_options = sig
   val _dtypedtree : unit -> unit
   val _drawlambda : unit -> unit
   val _dlambda : unit -> unit
-  val _dinstr : unit -> unit
 
   val anonymous : string -> unit
-end;;
+end
 
-module type Optcomp_options = sig
+module type Compiler_options =  sig
   val _a : unit -> unit
-  val _absname : unit -> unit
   val _annot : unit -> unit
   val _binannot : unit -> unit
   val _c : unit -> unit
   val _cc : string -> unit
   val _cclib : string -> unit
   val _ccopt : string -> unit
-  val _compact : unit -> unit
   val _config : unit -> unit
   val _for_pack : string -> unit
   val _g : unit -> unit
   val _i : unit -> unit
-  val _I : string -> unit
   val _impl : string -> unit
-  val _inline : int -> unit
   val _intf : string -> unit
   val _intf_suffix : string -> unit
   val _keep_locs : unit -> unit
-  val _labels : unit -> unit
   val _linkall : unit -> unit
-  val _no_app_funct : unit -> unit
-  val _noassert : unit -> unit
   val _noautolink : unit -> unit
-  val _nodynlink : unit -> unit
-  val _nolabels : unit -> unit
-  val _nostdlib : unit -> unit
   val _o : string -> unit
   val _output_obj : unit -> unit
-  val _p : unit -> unit
   val _pack : unit -> unit
   val _pp : string -> unit
-  val _ppx : string -> unit
   val _principal : unit -> unit
   val _rectypes : unit -> unit
   val _runtime_variant : string -> unit
-  val _S : unit -> unit
-  val _shared : unit -> unit
+  val _safe_string : unit -> unit
   val _short_paths : unit -> unit
-  val _strict_sequence : unit -> unit
-  val _trans_mod : unit -> unit
   val _thread : unit -> unit
-  val _unsafe : unit -> unit
   val _v : unit -> unit
   val _verbose : unit -> unit
-  val _version : unit -> unit
-  val _vnum : unit -> unit
-  val _w : string -> unit
-  val _warn_error : string -> unit
-  val _warn_help : unit -> unit
   val _where : unit -> unit
 
   val _nopervasives : unit -> unit
-  val _dsource : unit -> unit
-  val _dparsetree : unit -> unit
-  val _dtypedtree : unit -> unit
-  val _drawlambda : unit -> unit
-  val _dlambda : unit -> unit
-  val _dclambda : unit -> unit
-  val _dcmm : unit -> unit
-  val _dsel : unit -> unit
-  val _dcombine : unit -> unit
-  val _dlive : unit -> unit
-  val _dspill : unit -> unit
-  val _dsplit : unit -> unit
-  val _dinterf : unit -> unit
-  val _dprefer : unit -> unit
-  val _dalloc : unit -> unit
-  val _dreload : unit -> unit
-  val _dscheduling :  unit -> unit
-  val _dlinear :  unit -> unit
-  val _dstartup :  unit -> unit
+end
+;;
 
-  val anonymous : string -> unit
+module type Bytecomp_options = sig
+  include Common_options
+  include Compiler_options
+  val _compat_32 : unit -> unit
+  val _custom : unit -> unit
+  val _dllib : string -> unit
+  val _dllpath : string -> unit
+  val _make_runtime : unit -> unit
+  val _vmthread : unit -> unit
+  val _use_runtime : string -> unit
+
+  val _dinstr : unit -> unit
+
+  val _use_prims : string -> unit
 end;;
 
-module type Opttop_options = sig
-  val _absname : unit -> unit
-  val _compact : unit -> unit
-  val _I : string -> unit
+module type Bytetop_options = sig
+  include Common_options
   val _init : string -> unit
-  val _inline : int -> unit
-  val _labels : unit -> unit
-  val _no_app_funct : unit -> unit
-  val _noassert : unit -> unit
   val _noinit : unit -> unit
-  val _nolabels : unit -> unit
   val _noprompt : unit -> unit
   val _nopromptcont : unit -> unit
-  val _nostdlib : unit -> unit
-  val _ppx : string -> unit
-  val _principal : unit -> unit
-  val _rectypes : unit -> unit
-  val _S : unit -> unit
-  val _short_paths : unit -> unit
   val _stdin : unit -> unit
-  val _strict_sequence : unit -> unit
-  val _trans_mod : unit -> unit
-  val _unsafe : unit -> unit
-  val _version : unit -> unit
-  val _vnum : unit -> unit
-  val _w : string -> unit
-  val _warn_error : string -> unit
-  val _warn_help : unit -> unit
 
-  val _dsource : unit -> unit
-  val _dparsetree : unit -> unit
-  val _dtypedtree : unit -> unit
-  val _drawlambda : unit -> unit
-  val _dlambda : unit -> unit
+  val _dinstr : unit -> unit
+end;;
+
+module type Optcommon_options = sig
+  val _compact : unit -> unit
+  val _inline : int -> unit
+
   val _dclambda : unit -> unit
   val _dcmm : unit -> unit
   val _dsel : unit -> unit
   val _dcombine : unit -> unit
+  val _dcse : unit -> unit
   val _dlive : unit -> unit
   val _dspill : unit -> unit
   val _dsplit : unit -> unit
@@ -238,8 +125,29 @@ module type Opttop_options = sig
   val _dscheduling :  unit -> unit
   val _dlinear :  unit -> unit
   val _dstartup :  unit -> unit
+end;;
 
-  val anonymous : string -> unit
+module type Optcomp_options = sig
+  include Common_options
+  include Compiler_options
+  include Optcommon_options
+  val _no_float_const_prop : unit -> unit
+  val _nodynlink : unit -> unit
+  val _p : unit -> unit
+  val _pp : string -> unit
+  val _S : unit -> unit
+  val _shared : unit -> unit
+end;;
+
+module type Opttop_options = sig
+  include Common_options
+  include Optcommon_options
+  val _init : string -> unit
+  val _noinit : unit -> unit
+  val _noprompt : unit -> unit
+  val _nopromptcont : unit -> unit
+  val _S : unit -> unit
+  val _stdin : unit -> unit
 end;;
 
 module type Arg_list = sig
diff --git a/driver/optcompile.ml b/driver/optcompile.ml
index 625c0223e7..f0ef78d1cb 100644
--- a/driver/optcompile.ml
+++ b/driver/optcompile.ml
@@ -22,17 +22,17 @@ open Compenv
 
 (* Keep in sync with the copy in compile.ml *)
 
+let tool_name = "ocamlopt"
+
 let interface ppf sourcefile outputprefix =
   Compmisc.init_path false;
-  let modulename =
-    String.capitalize(Filename.basename(chop_extension_if_any sourcefile)) in
-  check_unit_name ppf sourcefile modulename;
+  let modulename = module_of_filename ppf sourcefile outputprefix in
   Env.set_unit_name modulename;
   let initial_env = Compmisc.initial_env () in
-  let ast = Pparse.parse_interface ppf sourcefile in
+  let ast = Pparse.parse_interface ~tool_name ppf sourcefile in
   if !Clflags.dump_parsetree then fprintf ppf "%a@." Printast.interface ast;
   if !Clflags.dump_source then fprintf ppf "%a@." Pprintast.signature ast;
-  let tsg = Typemod.transl_signature initial_env ast in
+  let tsg = Typemod.type_interface initial_env ast in
   if !Clflags.dump_typedtree then fprintf ppf "%a@." Printtyped.interface tsg;
   let sg = tsg.sig_type in
   if !Clflags.print_types then
@@ -59,9 +59,7 @@ let (+++) (x, y) f = (x, f y)
 
 let implementation ppf sourcefile outputprefix =
   Compmisc.init_path true;
-  let modulename =
-    String.capitalize(Filename.basename(chop_extension_if_any sourcefile)) in
-  check_unit_name ppf sourcefile modulename;
+  let modulename = module_of_filename ppf sourcefile outputprefix in
   Env.set_unit_name modulename;
   let env = Compmisc.initial_env() in
   Compilenv.reset ?packname:!Clflags.for_package modulename;
@@ -94,7 +92,7 @@ let implementation ppf sourcefile outputprefix =
     Warnings.check_fatal ();
     Stypes.dump (Some (outputprefix ^ ".annot"))
   in
-  try comp (Pparse.parse_implementation ppf sourcefile)
+  try comp (Pparse.parse_implementation ~tool_name ppf sourcefile)
   with x ->
     Stypes.dump (Some (outputprefix ^ ".annot"));
     remove_file objfile;
diff --git a/driver/optmain.ml b/driver/optmain.ml
index d04ad76b19..a520a8ce14 100644
--- a/driver/optmain.ml
+++ b/driver/optmain.ml
@@ -93,13 +93,16 @@ module Options = Main_args.Make_optcomp_options (struct
   let _keep_locs = set keep_locs
   let _labels = clear classic
   let _linkall = set link_everything
+  let _no_alias_deps = set transparent_modules
   let _no_app_funct = clear applicative_functors
+  let _no_float_const_prop = clear float_const_prop
   let _noassert = set noassert
   let _noautolink = set no_auto_link
   let _nodynlink = clear dlcode
   let _nolabels = set classic
   let _nostdlib = set no_std_include
   let _o s = output_name := Some s
+  let _open s = open_modules := s :: !open_modules
   let _output_obj = set output_c_object
   let _p = set gprofile
   let _pack = set make_package
@@ -108,13 +111,14 @@ module Options = Main_args.Make_optcomp_options (struct
   let _principal = set principal
   let _rectypes = set recursive_types
   let _runtime_variant s = runtime_variant := s
+  let _safe_string = clear unsafe_string
   let _short_paths = clear real_paths
   let _strict_sequence = set strict_sequence
-  let _trans_mod = set transparent_modules
   let _shared () = shared := true; dlcode := true
   let _S = set keep_asm_file
   let _thread = set use_threads
   let _unsafe = set fast
+  let _unsafe_string = set unsafe_string
   let _v () = print_version_and_library "native-code compiler"
   let _version () = print_version_string ()
   let _vnum () = print_version_string ()
@@ -134,6 +138,7 @@ module Options = Main_args.Make_optcomp_options (struct
   let _dcmm = set dump_cmm
   let _dsel = set dump_selection
   let _dcombine = set dump_combine
+  let _dcse = set dump_cse
   let _dlive () = dump_live := true; Printmach.print_live := true
   let _dspill = set dump_spill
   let _dsplit = set dump_split
@@ -172,7 +177,8 @@ let main () =
     else if !make_package then begin
       Compmisc.init_path true;
       let target = extract_output !output_name in
-      Asmpackager.package_files ppf (get_objfiles ()) target;
+      Asmpackager.package_files ppf (Compmisc.initial_env ())
+        (get_objfiles ()) target;
       Warnings.check_fatal ();
     end
     else if !shared then begin
diff --git a/driver/pparse.ml b/driver/pparse.ml
index 7f9974da7a..08b9bc736e 100644
--- a/driver/pparse.ml
+++ b/driver/pparse.ml
@@ -64,7 +64,7 @@ let apply_rewriter magic fn_in ppx =
   (* check magic before passing to the next ppx *)
   let ic = open_in_bin fn_out in
   let buffer =
-    try Misc.input_bytes ic (String.length magic) with End_of_file -> "" in
+    try really_input_string ic (String.length magic) with End_of_file -> "" in
   close_in ic;
   if buffer <> magic then begin
     Misc.remove_file fn_out;
@@ -75,7 +75,7 @@ let apply_rewriter magic fn_in ppx =
 let read_ast magic fn =
   let ic = open_in_bin fn in
   try
-    let buffer = Misc.input_bytes ic (String.length magic) in
+    let buffer = really_input_string ic (String.length magic) in
     assert(buffer = magic); (* already checked by apply_rewriter *)
     Location.input_name := input_value ic;
     let ast = input_value ic in
@@ -87,25 +87,51 @@ let read_ast magic fn =
     Misc.remove_file fn;
     raise exn
 
-let apply_rewriters magic ast =
+let apply_rewriters ~tool_name magic ast =
+  let ctx = Ast_mapper.ppx_context ~tool_name () in
   match !Clflags.all_ppx with
   | [] -> ast
   | ppxs ->
+      let ast =
+        if magic = Config.ast_impl_magic_number
+        then Obj.magic (Ast_helper.Str.attribute ctx :: (Obj.magic ast))
+        else Obj.magic (Ast_helper.Sig.attribute ctx :: (Obj.magic ast))
+      in
       let fn =
         List.fold_left (apply_rewriter magic) (write_ast magic ast)
           (List.rev ppxs)
       in
-      read_ast magic fn
+      let ast = read_ast magic fn in
+      let open Parsetree in
+      if magic = Config.ast_impl_magic_number then
+        let ast =
+          match Obj.magic ast with
+          | {pstr_desc = Pstr_attribute({Location.txt = "ocaml.ppx.context"}, _)}
+            :: items ->
+              items
+          | items -> items
+        in
+        Obj.magic ast
+      else
+        let ast =
+          match Obj.magic ast with
+          | {psig_desc = Psig_attribute({Location.txt = "ocaml.ppx.context"}, _)}
+            :: items ->
+              items
+          | items -> items
+        in
+        Obj.magic ast
+
 
 (* Parse a file or get a dumped syntax tree from it *)
 
 exception Outdated_version
 
-let file ppf inputfile parse_fun ast_magic =
+let file ppf ~tool_name inputfile parse_fun ast_magic =
   let ic = open_in_bin inputfile in
   let is_ast_file =
     try
-      let buffer = Misc.input_bytes ic (String.length ast_magic) in
+      let buffer = really_input_string ic (String.length ast_magic) in
       if buffer = ast_magic then true
       else if String.sub buffer 0 9 = String.sub ast_magic 0 9 then
         raise Outdated_version
@@ -134,7 +160,7 @@ let file ppf inputfile parse_fun ast_magic =
     with x -> close_in ic; raise x
   in
   close_in ic;
-  apply_rewriters ast_magic ast
+  apply_rewriters ~tool_name ast_magic ast
 
 let report_error ppf = function
   | CannotRun cmd ->
@@ -151,11 +177,11 @@ let () =
       | _ -> None
     )
 
-let parse_all parse_fun magic ppf sourcefile =
+let parse_all ~tool_name parse_fun magic ppf sourcefile =
   Location.input_name := sourcefile;
   let inputfile = preprocess sourcefile in
   let ast =
-    try file ppf inputfile parse_fun magic
+    try file ppf ~tool_name inputfile parse_fun magic
     with exn ->
       remove_preprocessed inputfile;
       raise exn
@@ -163,7 +189,9 @@ let parse_all parse_fun magic ppf sourcefile =
   remove_preprocessed inputfile;
   ast
 
-let parse_implementation ppf sourcefile =
-  parse_all Parse.implementation Config.ast_impl_magic_number ppf sourcefile
-let parse_interface ppf sourcefile =
-  parse_all Parse.interface Config.ast_intf_magic_number ppf sourcefile
+let parse_implementation ppf ~tool_name sourcefile =
+  parse_all ~tool_name Parse.implementation
+    Config.ast_impl_magic_number ppf sourcefile
+let parse_interface ppf ~tool_name sourcefile =
+  parse_all ~tool_name Parse.interface
+    Config.ast_intf_magic_number ppf sourcefile
diff --git a/driver/pparse.mli b/driver/pparse.mli
index 6a53f3fa99..d45adf91de 100644
--- a/driver/pparse.mli
+++ b/driver/pparse.mli
@@ -20,10 +20,10 @@ exception Error of error
 
 val preprocess : string -> string
 val remove_preprocessed : string -> unit
-val file : formatter -> string -> (Lexing.lexbuf -> 'a) -> string -> 'a
-val apply_rewriters : string -> 'a -> 'a
+val file : formatter -> tool_name:string -> string -> (Lexing.lexbuf -> 'a) -> string -> 'a
+val apply_rewriters : tool_name:string -> string -> 'a -> 'a
 val report_error : formatter -> error -> unit
 
 
-val parse_implementation: formatter -> string -> Parsetree.structure
-val parse_interface: formatter -> string -> Parsetree.signature
+val parse_implementation: formatter -> tool_name:string -> string -> Parsetree.structure
+val parse_interface: formatter -> tool_name:string -> string -> Parsetree.signature
diff --git a/lex/Makefile b/lex/Makefile
index e3cbd320be..cb5df8b41c 100644
--- a/lex/Makefile
+++ b/lex/Makefile
@@ -13,7 +13,7 @@
 # The lexer generator
 CAMLC=../boot/ocamlrun ../boot/ocamlc -strict-sequence -nostdlib -I ../boot
 CAMLOPT=../boot/ocamlrun ../ocamlopt -nostdlib -I ../stdlib
-COMPFLAGS=-w +33..39 -warn-error A -bin-annot
+COMPFLAGS=-w +33..39 -warn-error A -bin-annot -safe-string
 CAMLYACC=../boot/ocamlyacc
 YACCFLAGS=-v
 CAMLLEX=../boot/ocamlrun ../boot/ocamllex
diff --git a/lex/common.ml b/lex/common.ml
index 13b48fac6d..9b86ba111f 100644
--- a/lex/common.ml
+++ b/lex/common.ml
@@ -47,7 +47,7 @@ let update_tracker tr =
   fprintf tr.oc "# %d \"%s\"\n" (tr.cur_line+1) tr.file;
 ;;
 
-let copy_buffer = String.create 1024
+let copy_buffer = Bytes.create 1024
 
 let copy_chars_unix ic oc start stop =
   let n = ref (stop - start) in
diff --git a/man/ocaml.m b/man/ocaml.m
index b393b771c1..6764d52ce3 100644
--- a/man/ocaml.m
+++ b/man/ocaml.m
@@ -133,6 +133,12 @@ window.
 Do not include the standard library directory in the list of
 directories searched for source and compiled files.
 .TP
+.BI \-open \ module
+Opens the given module before starting the toplevel. If several
+.B \-open
+options are given, they are processed in order, just as if
+the statements open! module1;; ... open! moduleN;; were input.
+.TP
 .BI \-ppx \ command
 After parsing, pipe the abstract syntax tree through the preprocessor
 .IR command .
@@ -157,6 +163,12 @@ Allow arbitrary recursive types during type-checking.  By default,
 only recursive types where the recursion goes through an object type
 are supported.
 .TP
+.B \-safe\-string
+Enforce the separation between types
+.BR string \ and\  bytes ,
+thereby making strings read-only. This will become the default in
+a future version of OCaml.
+.TP
 .B \-short\-paths
 When a type is visible under several module-paths, use the shortest
 one when printing the type's name in inferred interfaces and error and
@@ -177,13 +189,20 @@ constructs). Programs compiled with
 are therefore slightly faster, but unsafe: anything can happen if the program
 accesses an array or string outside of its bounds.
 .TP
+.B \-unsafe\-string
+Identify the types
+.BR string \ and\  bytes ,
+thereby making strings writable. For reasons of backward compatibility,
+this is the default setting for the moment, but this will change in a future
+version of OCaml.
+.TP
 .B \-version
 Print version string and exit.
 .TP
 .B \-vnum
 Print short version number and exit.
 .TP
-.BI \-w \ warning-list
+.BI \-w \ warning\-list
 Enable or disable warnings according to the argument
 .IR warning-list .
 See
@@ -192,7 +211,7 @@ for the syntax of the
 .I warning\-list
 argument.
 .TP
-.BI \-warn-error \ warning-list
+.BI \-warn\-error \ warning\-list
 Mark as fatal the warnings described by the argument
 .IR warning\-list .
 Note that a warning is not triggered (and does not trigger an error) if
diff --git a/man/ocamlc.m b/man/ocamlc.m
index 1d3c56faa0..8661a76a76 100644
--- a/man/ocamlc.m
+++ b/man/ocamlc.m
@@ -396,6 +396,9 @@ bytecode executables produced with the option
 .B ocamlc\ \-use\-runtime
 .IR runtime-name .
 .TP
+.B \-no-alias-deps
+Do not record dependencies for module aliases.
+.TP
 .B \-no\-app\-funct
 Deactivates the applicative behaviour of functors. With this option,
 each functor application generates new types in its result and
@@ -446,6 +449,18 @@ packed object file produced.  If the
 .B \-output\-obj
 option is given,
 specify the name of the output file produced.
+This can also be used when compiling an interface or implementation
+file, without linking, in which case it sets the name of the cmi or
+cmo file, and also sets the module name to the file name up to the
+first dot.
+.TP
+.BI \-open \ module
+Opens the given module before processing the interface or
+implementation files. If several
+.B \-open
+options are given, they are processed in order, just as if
+the statements open! module1;; ... open! moduleN;; were added
+at the top of each file.
 .TP
 .B \-output\-obj
 Cause the linker to produce a C object file instead of a bytecode
@@ -519,6 +534,12 @@ then the
 .B d
 suffix is supported and gives a debug version of the runtime.
 .TP
+.B \-safe\-string
+Enforce the separation between types
+.BR string \ and\  bytes ,
+thereby making strings read-only. This will become the default in
+a future version of OCaml.
+.TP
 .B \-short\-paths
 When a type is visible under several module-paths, use the shortest
 one when printing the type's name in inferred interfaces and error and
@@ -541,6 +562,13 @@ are therefore
 slightly faster, but unsafe: anything can happen if the program
 accesses an array or string outside of its bounds.
 .TP
+.B \-unsafe\-string
+Identify the types
+.BR string \ and\  bytes ,
+thereby making strings writable. For reasons of backward compatibility,
+this is the default setting for the moment, but this will change in a future
+version of OCaml.
+.TP
 .BI \-use\-runtime \ runtime\-name
 Generate a bytecode executable file that can be executed on the custom
 runtime system
@@ -773,7 +801,7 @@ mutually recursive types.
 \ \ Unused constructor.
 
 38
-\ \ Unused exception constructor.
+\ \ Unused extension constructor.
 
 39
 \ \ Unused rec flag.
@@ -875,7 +903,7 @@ Note: it is not recommended to use the
 .B \-warn\-error
 option in production code, because it will almost certainly prevent
 compiling your program with later versions of OCaml when they add new
-warnings.
+warnings or modify existing warnings.
 
 The default setting is
 .B \-warn\-error\ -a (all warnings are non-fatal).
diff --git a/man/ocamlopt.m b/man/ocamlopt.m
index 766d2a4c6b..98ff86bf95 100644
--- a/man/ocamlopt.m
+++ b/man/ocamlopt.m
@@ -316,6 +316,9 @@ flag forces all
 subsequent links of programs involving that library to link all the
 modules contained in the library.
 .TP
+.B \-no-alias-deps
+Do not record dependencies for module aliases.
+.TP
 .B \-no\-app\-funct
 Deactivates the applicative behaviour of functors. With this option,
 each functor application generates new types in its result and
@@ -364,6 +367,18 @@ If the
 option is given, specify the name of the output file produced. If the
 .B \-shared
 option is given, specify the name of plugin file produced.
+This can also be used when compiling an interface or implementation
+file, without linking, in which case it sets the name of the cmi or
+cmo file, and also sets the module name to the file name up to the
+first dot.
+.TP
+.BI \-open \ module
+Opens the given module before processing the interface or
+implementation files. If several
+.B \-open
+options are given, they are processed in order, just as if
+the statements open! module1;; ... open! moduleN;; were added
+at the top of each file.
 .TP
 .B \-output\-obj
 Cause the linker to produce a C object file instead of an executable
@@ -475,6 +490,12 @@ code for the source file
 is saved in the file
 .IR x .s.
 .TP
+.B \-safe\-string
+Enforce the separation between types
+.BR string \ and\  bytes ,
+thereby making strings read-only. This will become the default in
+a future version of OCaml.
+.TP
 .B \-shared
 Build a plugin (usually .cmxs) that can be dynamically loaded with
 the
@@ -522,6 +543,13 @@ program or continue with an unspecified result instead of raising a
 .B Division_by_zero
 exception.
 .TP
+.B \-unsafe\-string
+Identify the types
+.BR string \ and\  bytes ,
+thereby making strings writable. For reasons of backward compatibility,
+this is the default setting for the moment, but this will change in a future
+version of OCaml.
+.TP
 .B \-v
 Print the version number of the compiler and the location of the
 standard library directory, then exit.
@@ -563,7 +591,7 @@ Note: it is not recommended to use the
 .B \-warn\-error
 option in production code, because it will almost certainly prevent
 compiling your program with later versions of OCaml when they add new
-warnings.
+warnings or modify existing warnings.
 
 The default setting is
 .B \-warn\-error\ -a (all warnings are non-fatal).
diff --git a/ocamlbuild/Makefile b/ocamlbuild/Makefile
index 54d6283246..9f5dda3269 100644
--- a/ocamlbuild/Makefile
+++ b/ocamlbuild/Makefile
@@ -19,7 +19,7 @@ OCAMLOPT  = $(OCAMLRUN) $(ROOTDIR)/ocamlopt -nostdlib -I $(ROOTDIR)/stdlib
 OCAMLDEP  = $(OCAMLRUN) $(ROOTDIR)/tools/ocamldep
 OCAMLLEX  = $(OCAMLRUN) $(ROOTDIR)/boot/ocamllex
 CP        = cp
-COMPFLAGS= -warn-error A -w L -w R -w Z -I ../otherlibs/$(UNIXLIB)
+COMPFLAGS= -warn-error A -w L -w R -w Z -I ../otherlibs/$(UNIXLIB) -safe-string
 LINKFLAGS= -I ../otherlibs/$(UNIXLIB)
 
 PACK_CMO=\
@@ -73,6 +73,7 @@ EXTRA_CMO=\
 
 PACK_CMX=$(PACK_CMO:.cmo=.cmx)
 EXTRA_CMX=$(EXTRA_CMO:.cmo=.cmx)
+EXTRA_CMI=$(EXTRA_CMO:.cmo=.cmi)
 
 INSTALL_LIB=\
   ocamlbuildlib.cma \
@@ -197,6 +198,10 @@ clean::
 depend: beforedepend
 	$(OCAMLDEP) *.mli *.ml > .depend
 
+$(EXTRA_CMI): ocamlbuild_pack.cmi
+$(EXTRA_CMO): ocamlbuild_pack.cmo ocamlbuild_pack.cmi
+$(EXTRA_CMX): ocamlbuild_pack.cmx ocamlbuild_pack.cmi
+
 include .depend
 
 .PHONY: all allopt clean beforedepend
diff --git a/ocamlbuild/Makefile.noboot b/ocamlbuild/Makefile.noboot
index de914e15ec..313e56891c 100644
--- a/ocamlbuild/Makefile.noboot
+++ b/ocamlbuild/Makefile.noboot
@@ -56,7 +56,7 @@ INCLUDES_NODEP=	-I $(OCAMLSRCDIR)/stdlib \
 
 INCLUDES=$(INCLUDES_DEP) $(INCLUDES_NODEP)
 
-COMPFLAGS=$(INCLUDES) -warn-error A
+COMPFLAGS=$(INCLUDES) -warn-error A -safe-string
 LINKFLAGS=$(INCLUDES)
 
 CMOFILES_PACK= 			            \
diff --git a/ocamlbuild/display.ml b/ocamlbuild/display.ml
index 725d351bb6..2e0b1e39ea 100644
--- a/ocamlbuild/display.ml
+++ b/ocamlbuild/display.ml
@@ -51,7 +51,7 @@ type sophisticated_display = {
           ds_columns         : int;                    (** Number of columns in dssplay *)
   mutable ds_jobs            : int;                    (** Number of jobs launched or cached *)
   mutable ds_jobs_cached     : int;                    (** Number of jobs cached *)
-          ds_tagline         : string;                 (** Current tagline *)
+          ds_tagline         : bytes;                  (** Current tagline *)
   mutable ds_seen_tags       : Tags.t;                 (** Tags that we have encountered *)
           ds_pathname_length : int;                    (** How much space for displaying pathnames ? *)
           ds_tld             : tagline_description;    (** Description for the tagline *)
@@ -105,7 +105,7 @@ let uncached = " ";;
 let cache_chars = 1;;
 (* ***)
 (*** create_tagline *)
-let create_tagline description = String.make (List.length description) '-';;
+let create_tagline description = Bytes.make (List.length description) '-';;
 (* ***)
 (*** create *)
 let create
@@ -184,7 +184,7 @@ let print_shortened_pathname length oc u =
       let n = String.length dots in
       let k = length - n in
       output_string oc dots;
-      output oc u (m - k) k;
+      output_substring oc u (m - k) k;
     end
 (* ***)
 (*** Layout
@@ -216,7 +216,7 @@ let redraw_sophisticated ds =
     ds.ds_jobs_cached
     (print_shortened_pathname ds.ds_pathname_length) ds.ds_last_target
     (if ds.ds_last_cached then cached else uncached)
-    ds.ds_tagline
+    (Bytes.to_string ds.ds_tagline)
     ticker;
   fp oc "%a%!" ANSI.clear_to_eol ()
 ;;
@@ -292,17 +292,17 @@ let update_tagline_from_tags ds =
   let tags = ds.ds_last_tags in
   let rec loop i = function
     | [] ->
-        for j = i to String.length tagline - 1 do
-          tagline.[j] <- '-'
+        for j = i to Bytes.length tagline - 1 do
+          Bytes.set tagline j '-'
         done
     | (tag, c) :: rest ->
         if Tags.mem tag tags then
-          tagline.[i] <- Char.uppercase c
+          Bytes.set tagline i (Char.uppercase c)
         else
           if Tags.mem tag ds.ds_seen_tags then
-            tagline.[i] <- Char.lowercase c
+            Bytes.set tagline i (Char.lowercase c)
           else
-            tagline.[i] <- '-';
+            Bytes.set tagline i '-';
         loop (i + 1) rest
   in
   loop 0 ds.ds_tld;
diff --git a/ocamlbuild/main.ml b/ocamlbuild/main.ml
index 5f86f7932a..7413a7a7f6 100644
--- a/ocamlbuild/main.ml
+++ b/ocamlbuild/main.ml
@@ -56,9 +56,12 @@ let show_documentation () =
    this means that even if they were not part of any flag declaration,
    they should be marked as useful, to avoid the "unused tag" warning. *)
 let builtin_useful_tags =
-  Tags.of_list
-    ["include"; "traverse"; "not_hygienic";
-     "pack"; "ocamlmklib"; "native"; "thread"; "nopervasives"]
+  Tags.of_list [
+    "include"; "traverse"; "not_hygienic";
+    "pack"; "ocamlmklib"; "native"; "thread";
+    "nopervasives"; "use_menhir"; "ocamldep";
+    "thread";
+  ]
 ;;
 
 let proceed () =
@@ -110,7 +113,7 @@ let proceed () =
   let entry_include_dirs = ref [] in
   let entry =
     Slurp.filter
-      begin fun path name _ ->
+      begin fun path name () ->
         let dir =
           if path = Filename.current_dir_name then
             None
@@ -118,8 +121,21 @@ let proceed () =
             Some path
         in
         let path_name = path/name in
-        if name = "_tags" then
-          ignore (Configuration.parse_file ?dir path_name);
+
+        if name = "_tags" then begin
+          let tags_path =
+            (* PR#6482: remember that this code is run lazily by the Slurp command,
+               and may run only after the working directory has been changed.
+
+               On the other hand, always using the absolute path makes
+               error messages longer and more frigthening in case of
+               syntax error in the _tags file. So we use the absolute
+               path only when necessary -- the working directory has
+               changed. *)
+            if Sys.getcwd () = Pathname.pwd then path_name
+            else Pathname.pwd / path_name in
+          ignore (Configuration.parse_file ?dir tags_path);
+        end;
 
         (List.mem name ["_oasis"] || (String.length name > 0 && name.[0] <> '_'))
         && (name <> !Options.build_dir && not (List.mem name !Options.exclude_dirs))
@@ -148,10 +164,9 @@ let proceed () =
       let tags = tags_of_pathname (path/name) in
       not (Tags.mem "not_hygienic" tags) && not (Tags.mem "precious" tags)
     end entry in
+  Slurp.force hygiene_entry;
   if !Options.hygiene && not first_run_for_plugin then
-    Fda.inspect hygiene_entry
-  else
-    Slurp.force hygiene_entry;
+    Fda.inspect hygiene_entry;
   let entry = hygiene_entry in
   Hooks.call_hook Hooks.After_hygiene;
   Options.include_dirs := Pathname.current_dir_name :: List.rev !entry_include_dirs;
@@ -282,8 +297,10 @@ let main () =
           Log.finish ~how:`Quiet ();
           Pervasives.exit rc
       | Solver.Failed backtrace ->
-          Log.raw_dprintf (-1) "@[<v0>@[<2>Solver failed:@ %a@]@\n@[<v2>Backtrace:%a@]@]@."
-            Report.print_backtrace_analyze backtrace Report.print_backtrace backtrace;
+          Log.raw_dprintf (-1) "@[<v0>@[<2>Solver failed:@ %a@]@."
+            Report.print_backtrace_analyze backtrace;
+          Log.raw_dprintf 1 "@[<v2>Backtrace:%a@]@]@."
+            Report.print_backtrace backtrace;
           exit rc_solver_failed
       | Failure s ->
           Log.eprintf "Failure:@ %s." s;
diff --git a/ocamlbuild/my_std.ml b/ocamlbuild/my_std.ml
index e0d2c8a9ca..c283987cc2 100644
--- a/ocamlbuild/my_std.ml
+++ b/ocamlbuild/my_std.ml
@@ -180,14 +180,7 @@ module String = struct
     in loop s 0
 
   let tr patt subst text =
-    let len = length text in
-    let text = copy text in
-    let rec loop pos =
-      if pos < len then begin
-        (if text.[pos] = patt then text.[pos] <- subst);
-        loop (pos + 1)
-      end
-    in loop 0; text
+    String.map (fun c -> if c = patt then subst else c) text
 
   (*** is_prefix : is u a prefix of v ? *)
   let is_prefix u v =
@@ -211,23 +204,23 @@ module String = struct
 
   let rev s =
     let sl = String.length s in
-    let s' = String.create sl in
+    let s' = Bytes.create sl in
     for i = 0 to sl - 1 do
-      s'.[i] <- s.[sl - i - 1]
+      Bytes.set s' i s.[sl - i - 1]
     done;
-    s';;
+    Bytes.to_string s';;
 
   let implode l =
     match l with
     | [] -> ""
     | cs ->
-        let r = create (List.length cs) in
+        let r = Bytes.create (List.length cs) in
         let pos = ref 0 in
         List.iter begin fun c ->
-          unsafe_set r !pos c;
+          Bytes.unsafe_set r !pos c;
           incr pos
         end cs;
-        r
+        Bytes.to_string r
 
   let explode s =
     let sl = String.length s in
@@ -307,16 +300,14 @@ let with_output_file ?(bin=false) x f =
 let read_file x =
   with_input_file ~bin:true x begin fun ic ->
     let len = in_channel_length ic in
-    let buf = String.create len in
-    let () = really_input ic buf 0 len in
-    buf
+    really_input_string ic len
   end
 
 let copy_chan ic oc =
   let m = in_channel_length ic in
   let m = (m lsr 12) lsl 12 in
   let m = max 16384 (min Sys.max_string_length m) in
-  let buf = String.create m in
+  let buf = Bytes.create m in
   let rec loop () =
     let len = input ic buf 0 m in
     if len > 0 then begin
diff --git a/ocamlbuild/my_unix.ml b/ocamlbuild/my_unix.ml
index 43692d3219..fa1c5d45f4 100644
--- a/ocamlbuild/my_unix.ml
+++ b/ocamlbuild/my_unix.ml
@@ -127,13 +127,13 @@ let execute_many ?max_jobs = implem.execute_many ?max_jobs
 
 let run_and_read cmd =
   let bufsiz = 2048 in
-  let buf = String.create bufsiz in
+  let buf = Bytes.create bufsiz in
   let totalbuf = Buffer.create 4096 in
   implem.run_and_open cmd begin fun ic ->
     let rec loop pos =
       let len = input ic buf 0 bufsiz in
       if len > 0 then begin
-        Buffer.add_substring totalbuf buf 0 len;
+        Buffer.add_subbytes totalbuf buf 0 len;
         loop (pos + len)
       end
     in loop 0; Buffer.contents totalbuf
diff --git a/ocamlbuild/ocaml_specific.ml b/ocamlbuild/ocaml_specific.ml
index 1b41c0842b..43605d361e 100644
--- a/ocamlbuild/ocaml_specific.ml
+++ b/ocamlbuild/ocaml_specific.ml
@@ -665,6 +665,10 @@ flag ["ocaml"; "link"; "byte"; "output_obj"] (A"-output-obj");;
 flag ["ocaml"; "dtypes"; "compile"] (A "-dtypes");;
 flag ["ocaml"; "annot"; "compile"] (A "-annot");;
 flag ["ocaml"; "bin_annot"; "compile"] (A "-bin-annot");;
+flag ["ocaml"; "safe_string"; "compile"] (A "-safe-string");;
+flag ["ocaml"; "safe_string"; "infer_interface"] (A "-safe-string");;
+flag ["ocaml"; "unsafe_string"; "compile"] (A "-unsafe-string");;
+flag ["ocaml"; "unsafe_string"; "infer_interface"] (A "-unsafe-string");;
 flag ["ocaml"; "short_paths"; "compile"] (A "-short-paths");;
 flag ["ocaml"; "short_paths"; "infer_interface"] (A "-short-paths");;
 flag ["ocaml"; "rectypes"; "compile"] (A "-rectypes");;
@@ -678,6 +682,7 @@ flag ["ocaml"; "link"; "profile"; "native"] (A "-p");;
 flag ["ocaml"; "link"; "program"; "custom"; "byte"] (A "-custom");;
 flag ["ocaml"; "link"; "library"; "custom"; "byte"] (A "-custom");;
 flag ["ocaml"; "compile"; "profile"; "native"] (A "-p");;
+flag ["ocaml"; "compile"; "no_alias_deps";] (A "-no-alias-deps");;
 
 (* threads, with or without findlib *)
 flag ["ocaml"; "compile"; "thread"] (A "-thread");;
diff --git a/ocamlbuild/ocamlbuild_executor.ml b/ocamlbuild/ocamlbuild_executor.ml
index 53fcad1201..298f9b4dd7 100644
--- a/ocamlbuild/ocamlbuild_executor.ml
+++ b/ocamlbuild/ocamlbuild_executor.ml
@@ -59,22 +59,19 @@ let output_lines prefix oc buffer =
   let m = String.length u in
   let output_line i j =
     output_string oc prefix;
-    output oc u i (j - i);
+    output_substring oc u i (j - i);
     output_char oc '\n'
   in
   let rec loop i =
-    if i = m then
-      ()
+    if i < m then
+      let j =
+        try String.index_from u i '\n'
+        with Not_found -> m
+      in
+      output_line i j;
+      loop (j + 1)
     else
-      begin
-        try
-          let j = String.index_from u i '\n' in
-          output_line i j;
-          loop (j + 1)
-        with
-        | Not_found ->
-            output_line i m
-      end
+      ()
   in
   loop 0
 ;;
@@ -190,7 +187,7 @@ let execute
   (* ***)
   (*** do_read *)
   let do_read =
-    let u = String.create 4096 in
+    let u = Bytes.create 4096 in
     fun ?(loop=false) fd job ->
       (*if job.job_dying then
         ()
@@ -199,9 +196,13 @@ let execute
           let rec iteration () =
             let m =
               try
-                read fd u 0 (String.length u)
+                read fd u 0 (Bytes.length u)
               with
-              | Unix.Unix_error(_,_,_) -> 0
+              | Unix.Unix_error(e,_,_)  ->
+                let msg = error_message e in
+                display (fun oc -> fp oc
+                        "Error while reading stdout/stderr: %s\n" msg);
+                0
             in
             if m = 0 then
               if job.job_dying then
@@ -210,7 +211,7 @@ let execute
                 terminate job
             else
               begin
-                Buffer.add_substring job.job_buffer u 0 m;
+                Buffer.add_subbytes job.job_buffer u 0 m;
                 if loop then
                   iteration ()
                 else
@@ -237,6 +238,11 @@ let execute
       (*display begin fun oc -> fp oc "Terminating job %a\n%!" print_job_id job.job_id; end;*)
 
       decr jobs_active;
+
+      (* PR#5371: we would get EAGAIN below otherwise *)
+      clear_nonblock (doi job.job_stdout);
+      clear_nonblock (doi job.job_stderr);
+
       do_read ~loop:true (doi job.job_stdout) job;
       do_read ~loop:true (doi job.job_stderr) job;
       outputs := FDM.remove (doi job.job_stdout) (FDM.remove (doi job.job_stderr) !outputs);
diff --git a/ocamlbuild/options.ml b/ocamlbuild/options.ml
index 78cee63734..68c0ac85db 100644
--- a/ocamlbuild/options.ml
+++ b/ocamlbuild/options.ml
@@ -38,7 +38,7 @@ let make_links = ref true
 let nostdlib = ref false
 let use_menhir = ref false
 let catch_errors = ref true
-let use_ocamlfind = ref true
+let use_ocamlfind = ref false
 
 (* Currently only ocamlfind and menhir is defined as no-core tool,
    perhaps later we need something better *)
diff --git a/ocamlbuild/testsuite/internal.ml b/ocamlbuild/testsuite/internal.ml
index 5d3c288400..2a12070f95 100644
--- a/ocamlbuild/testsuite/internal.ml
+++ b/ocamlbuild/testsuite/internal.ml
@@ -251,4 +251,17 @@ let () = test "PluginTagsWarning"
                 in absence of plugin file \"myocamlbuild.ml\""
   ~targets:("main.ml", []) ();;
 
+let () = test "TagsInNonHygienic"
+  ~description:"Regression test for PR#6482, where a _tags \
+                in a non-traversed directory would cause \
+                ocamlbuild to abort"
+  ~options:[`no_ocamlfind]
+  ~tree:[
+    T.f "main.ml" ~content:"";
+    T.d "deps" [T.f "_tags" ~content:""];
+    T.f "_tags" ~content:"<deps>: not_hygienic\n";
+  ]
+  ~matching:[M.f "main.byte"]
+  ~targets:("main.byte",[]) ();;
+
 run ~root:"_test_internal";;
diff --git a/ocamldoc/.depend b/ocamldoc/.depend
index 38e932e35b..c2965f6a30 100644
--- a/ocamldoc/.depend
+++ b/ocamldoc/.depend
@@ -32,16 +32,16 @@ odoc_ast.cmo : ../typing/types.cmi ../typing/typedtree.cmi \
     ../typing/predef.cmi ../typing/path.cmi ../parsing/parsetree.cmi \
     odoc_value.cmo odoc_types.cmi odoc_type.cmo odoc_sig.cmi \
     odoc_parameter.cmo odoc_name.cmi odoc_module.cmo odoc_messages.cmo \
-    odoc_global.cmi odoc_exception.cmo odoc_env.cmi odoc_class.cmo \
-    ../utils/misc.cmi ../parsing/location.cmi ../typing/ident.cmi \
-    ../parsing/asttypes.cmi odoc_ast.cmi
+    odoc_global.cmi odoc_extension.cmo odoc_exception.cmo odoc_env.cmi \
+    odoc_class.cmo ../utils/misc.cmi ../parsing/location.cmi \
+    ../typing/ident.cmi ../parsing/asttypes.cmi odoc_ast.cmi
 odoc_ast.cmx : ../typing/types.cmx ../typing/typedtree.cmx \
     ../typing/predef.cmx ../typing/path.cmx ../parsing/parsetree.cmi \
     odoc_value.cmx odoc_types.cmx odoc_type.cmx odoc_sig.cmx \
     odoc_parameter.cmx odoc_name.cmx odoc_module.cmx odoc_messages.cmx \
-    odoc_global.cmx odoc_exception.cmx odoc_env.cmx odoc_class.cmx \
-    ../utils/misc.cmx ../parsing/location.cmx ../typing/ident.cmx \
-    ../parsing/asttypes.cmi odoc_ast.cmi
+    odoc_global.cmx odoc_extension.cmx odoc_exception.cmx odoc_env.cmx \
+    odoc_class.cmx ../utils/misc.cmx ../parsing/location.cmx \
+    ../typing/ident.cmx ../parsing/asttypes.cmi odoc_ast.cmi
 odoc_class.cmo : ../typing/types.cmi odoc_value.cmo odoc_types.cmi \
     odoc_parameter.cmo odoc_name.cmi
 odoc_class.cmx : ../typing/types.cmx odoc_value.cmx odoc_types.cmx \
@@ -62,12 +62,12 @@ odoc_control.cmo :
 odoc_control.cmx :
 odoc_cross.cmo : odoc_value.cmo odoc_types.cmi odoc_type.cmo odoc_search.cmi \
     odoc_scan.cmo odoc_parameter.cmo odoc_name.cmi odoc_module.cmo \
-    odoc_misc.cmi odoc_messages.cmo odoc_global.cmi odoc_exception.cmo \
-    odoc_class.cmo odoc_cross.cmi
+    odoc_misc.cmi odoc_messages.cmo odoc_global.cmi odoc_extension.cmo \
+    odoc_exception.cmo odoc_class.cmo odoc_cross.cmi
 odoc_cross.cmx : odoc_value.cmx odoc_types.cmx odoc_type.cmx odoc_search.cmx \
     odoc_scan.cmx odoc_parameter.cmx odoc_name.cmx odoc_module.cmx \
-    odoc_misc.cmx odoc_messages.cmx odoc_global.cmx odoc_exception.cmx \
-    odoc_class.cmx odoc_cross.cmi
+    odoc_misc.cmx odoc_messages.cmx odoc_global.cmx odoc_extension.cmx \
+    odoc_exception.cmx odoc_class.cmx odoc_cross.cmi
 odoc_dag2html.cmo : odoc_info.cmi odoc_dag2html.cmi
 odoc_dag2html.cmx : odoc_info.cmx odoc_dag2html.cmi
 odoc_dep.cmo : ../parsing/parsetree.cmi odoc_type.cmo odoc_print.cmi \
@@ -84,6 +84,10 @@ odoc_env.cmx : ../typing/types.cmx ../typing/printtyp.cmx \
     ../typing/btype.cmx odoc_env.cmi
 odoc_exception.cmo : ../typing/types.cmi odoc_types.cmi odoc_name.cmi
 odoc_exception.cmx : ../typing/types.cmx odoc_types.cmx odoc_name.cmx
+odoc_extension.cmo : ../typing/types.cmi odoc_types.cmi odoc_name.cmi \
+    ../parsing/asttypes.cmi
+odoc_extension.cmx : ../typing/types.cmx odoc_types.cmx odoc_name.cmx \
+    ../parsing/asttypes.cmi
 odoc_gen.cmo : odoc_texi.cmo odoc_module.cmo odoc_man.cmo odoc_latex.cmo \
     odoc_html.cmo odoc_dot.cmo odoc_gen.cmi
 odoc_gen.cmx : odoc_texi.cmx odoc_module.cmx odoc_man.cmx odoc_latex.cmx \
@@ -99,15 +103,15 @@ odoc_html.cmx : odoc_text.cmx odoc_ocamlhtml.cmx odoc_messages.cmx \
 odoc_info.cmo : ../typing/printtyp.cmi odoc_value.cmo odoc_types.cmi \
     odoc_type.cmo odoc_text.cmi odoc_str.cmi odoc_search.cmi odoc_scan.cmo \
     odoc_print.cmi odoc_parameter.cmo odoc_name.cmi odoc_module.cmo \
-    odoc_misc.cmi odoc_global.cmi odoc_exception.cmo odoc_dep.cmo \
-    odoc_config.cmi odoc_comments.cmi odoc_class.cmo odoc_analyse.cmi \
-    ../parsing/location.cmi odoc_info.cmi
+    odoc_misc.cmi odoc_global.cmi odoc_extension.cmo odoc_exception.cmo \
+    odoc_dep.cmo odoc_config.cmi odoc_comments.cmi odoc_class.cmo \
+    odoc_analyse.cmi ../parsing/location.cmi odoc_info.cmi
 odoc_info.cmx : ../typing/printtyp.cmx odoc_value.cmx odoc_types.cmx \
     odoc_type.cmx odoc_text.cmx odoc_str.cmx odoc_search.cmx odoc_scan.cmx \
     odoc_print.cmx odoc_parameter.cmx odoc_name.cmx odoc_module.cmx \
-    odoc_misc.cmx odoc_global.cmx odoc_exception.cmx odoc_dep.cmx \
-    odoc_config.cmx odoc_comments.cmx odoc_class.cmx odoc_analyse.cmx \
-    ../parsing/location.cmx odoc_info.cmi
+    odoc_misc.cmx odoc_global.cmx odoc_extension.cmx odoc_exception.cmx \
+    odoc_dep.cmx odoc_config.cmx odoc_comments.cmx odoc_class.cmx \
+    odoc_analyse.cmx ../parsing/location.cmx odoc_info.cmi
 odoc_inherit.cmo :
 odoc_inherit.cmx :
 odoc_latex.cmo : odoc_to_text.cmo odoc_messages.cmo odoc_latex_style.cmo \
@@ -126,10 +130,12 @@ odoc_man.cmx : odoc_str.cmx odoc_print.cmx odoc_misc.cmx odoc_messages.cmx \
     odoc_info.cmx ../utils/misc.cmx ../parsing/asttypes.cmi
 odoc_merge.cmo : odoc_value.cmo odoc_types.cmi odoc_type.cmo \
     odoc_parameter.cmo odoc_name.cmi odoc_module.cmo odoc_messages.cmo \
-    odoc_global.cmi odoc_exception.cmo odoc_class.cmo odoc_merge.cmi
+    odoc_global.cmi odoc_extension.cmo odoc_exception.cmo odoc_class.cmo \
+    odoc_merge.cmi
 odoc_merge.cmx : odoc_value.cmx odoc_types.cmx odoc_type.cmx \
     odoc_parameter.cmx odoc_name.cmx odoc_module.cmx odoc_messages.cmx \
-    odoc_global.cmx odoc_exception.cmx odoc_class.cmx odoc_merge.cmi
+    odoc_global.cmx odoc_extension.cmx odoc_exception.cmx odoc_class.cmx \
+    odoc_merge.cmi
 odoc_messages.cmo : ../utils/config.cmi
 odoc_messages.cmx : ../utils/config.cmx
 odoc_misc.cmo : ../typing/types.cmi ../typing/predef.cmi ../typing/path.cmi \
@@ -139,9 +145,11 @@ odoc_misc.cmx : ../typing/types.cmx ../typing/predef.cmx ../typing/path.cmx \
     odoc_types.cmx odoc_messages.cmx ../parsing/longident.cmx \
     ../typing/ctype.cmx ../typing/btype.cmx odoc_misc.cmi
 odoc_module.cmo : ../typing/types.cmi odoc_value.cmo odoc_types.cmi \
-    odoc_type.cmo odoc_name.cmi odoc_exception.cmo odoc_class.cmo
+    odoc_type.cmo odoc_name.cmi odoc_extension.cmo odoc_exception.cmo \
+    odoc_class.cmo
 odoc_module.cmx : ../typing/types.cmx odoc_value.cmx odoc_types.cmx \
-    odoc_type.cmx odoc_name.cmx odoc_exception.cmx odoc_class.cmx
+    odoc_type.cmx odoc_name.cmx odoc_extension.cmx odoc_exception.cmx \
+    odoc_class.cmx
 odoc_name.cmo : ../typing/path.cmi odoc_misc.cmi ../typing/ident.cmi \
     odoc_name.cmi
 odoc_name.cmx : ../typing/path.cmx odoc_misc.cmx ../typing/ident.cmx \
@@ -157,38 +165,38 @@ odoc_print.cmo : ../typing/types.cmi ../typing/printtyp.cmi \
 odoc_print.cmx : ../typing/types.cmx ../typing/printtyp.cmx \
     ../utils/misc.cmx odoc_print.cmi
 odoc_scan.cmo : odoc_value.cmo odoc_types.cmi odoc_type.cmo odoc_module.cmo \
-    odoc_exception.cmo odoc_class.cmo
+    odoc_extension.cmo odoc_exception.cmo odoc_class.cmo
 odoc_scan.cmx : odoc_value.cmx odoc_types.cmx odoc_type.cmx odoc_module.cmx \
-    odoc_exception.cmx odoc_class.cmx
+    odoc_extension.cmx odoc_exception.cmx odoc_class.cmx
 odoc_search.cmo : odoc_value.cmo odoc_types.cmi odoc_type.cmo \
-    odoc_parameter.cmo odoc_name.cmi odoc_module.cmo odoc_exception.cmo \
-    odoc_class.cmo odoc_search.cmi
+    odoc_parameter.cmo odoc_name.cmi odoc_module.cmo odoc_extension.cmo \
+    odoc_exception.cmo odoc_class.cmo odoc_search.cmi
 odoc_search.cmx : odoc_value.cmx odoc_types.cmx odoc_type.cmx \
-    odoc_parameter.cmx odoc_name.cmx odoc_module.cmx odoc_exception.cmx \
-    odoc_class.cmx odoc_search.cmi
+    odoc_parameter.cmx odoc_name.cmx odoc_module.cmx odoc_extension.cmx \
+    odoc_exception.cmx odoc_class.cmx odoc_search.cmi
 odoc_see_lexer.cmo : odoc_parser.cmi
 odoc_see_lexer.cmx : odoc_parser.cmx
 odoc_sig.cmo : ../typing/types.cmi ../typing/typedtree.cmi \
     ../typing/path.cmi ../parsing/parsetree.cmi odoc_value.cmo odoc_types.cmi \
     odoc_type.cmo odoc_parameter.cmo odoc_name.cmi odoc_module.cmo \
     odoc_misc.cmi odoc_messages.cmo odoc_merge.cmi odoc_global.cmi \
-    odoc_exception.cmo odoc_env.cmi odoc_class.cmo ../utils/misc.cmi \
-    ../parsing/location.cmi ../typing/ident.cmi ../typing/btype.cmi \
-    ../parsing/asttypes.cmi odoc_sig.cmi
+    odoc_extension.cmo odoc_exception.cmo odoc_env.cmi odoc_class.cmo \
+    ../utils/misc.cmi ../parsing/location.cmi ../typing/ident.cmi \
+    ../typing/btype.cmi ../parsing/asttypes.cmi odoc_sig.cmi
 odoc_sig.cmx : ../typing/types.cmx ../typing/typedtree.cmx \
     ../typing/path.cmx ../parsing/parsetree.cmi odoc_value.cmx odoc_types.cmx \
     odoc_type.cmx odoc_parameter.cmx odoc_name.cmx odoc_module.cmx \
     odoc_misc.cmx odoc_messages.cmx odoc_merge.cmx odoc_global.cmx \
-    odoc_exception.cmx odoc_env.cmx odoc_class.cmx ../utils/misc.cmx \
-    ../parsing/location.cmx ../typing/ident.cmx ../typing/btype.cmx \
-    ../parsing/asttypes.cmi odoc_sig.cmi
+    odoc_extension.cmx odoc_exception.cmx odoc_env.cmx odoc_class.cmx \
+    ../utils/misc.cmx ../parsing/location.cmx ../typing/ident.cmx \
+    ../typing/btype.cmx ../parsing/asttypes.cmi odoc_sig.cmi
 odoc_str.cmo : ../typing/types.cmi ../typing/printtyp.cmi odoc_value.cmo \
     odoc_type.cmo odoc_print.cmi odoc_name.cmi odoc_misc.cmi \
-    odoc_messages.cmo odoc_exception.cmo odoc_class.cmo \
+    odoc_messages.cmo odoc_extension.cmo odoc_exception.cmo odoc_class.cmo \
     ../parsing/asttypes.cmi odoc_str.cmi
 odoc_str.cmx : ../typing/types.cmx ../typing/printtyp.cmx odoc_value.cmx \
     odoc_type.cmx odoc_print.cmx odoc_name.cmx odoc_misc.cmx \
-    odoc_messages.cmx odoc_exception.cmx odoc_class.cmx \
+    odoc_messages.cmx odoc_extension.cmx odoc_exception.cmx odoc_class.cmx \
     ../parsing/asttypes.cmi odoc_str.cmi
 odoc_test.cmo : odoc_info.cmi odoc_gen.cmi odoc_args.cmi
 odoc_test.cmx : odoc_info.cmx odoc_gen.cmx odoc_args.cmx
@@ -219,8 +227,7 @@ odoc_value.cmx : ../typing/types.cmx ../typing/printtyp.cmx odoc_types.cmx \
 odoc_analyse.cmi : odoc_module.cmo odoc_global.cmi
 odoc_args.cmi : odoc_gen.cmi
 odoc_ast.cmi : ../typing/types.cmi ../typing/typedtree.cmi \
-    ../typing/path.cmi ../parsing/parsetree.cmi odoc_sig.cmi odoc_name.cmi \
-    odoc_module.cmo
+    ../parsing/parsetree.cmi odoc_sig.cmi odoc_name.cmi odoc_module.cmo
 odoc_comments.cmi : odoc_types.cmi odoc_module.cmo
 odoc_comments_global.cmi :
 odoc_config.cmi :
@@ -232,7 +239,8 @@ odoc_gen.cmi : odoc_texi.cmo odoc_module.cmo odoc_man.cmo odoc_latex.cmo \
 odoc_global.cmi : odoc_types.cmi
 odoc_info.cmi : ../typing/types.cmi odoc_value.cmo odoc_types.cmi \
     odoc_type.cmo odoc_search.cmi odoc_parameter.cmo odoc_module.cmo \
-    odoc_global.cmi odoc_exception.cmo odoc_class.cmo ../parsing/location.cmi
+    odoc_global.cmi odoc_extension.cmo odoc_exception.cmo odoc_class.cmo \
+    ../parsing/location.cmi
 odoc_merge.cmi : odoc_types.cmi odoc_module.cmo
 odoc_misc.cmi : ../typing/types.cmi odoc_types.cmi ../parsing/longident.cmi
 odoc_name.cmi : ../typing/path.cmi ../parsing/longident.cmi \
@@ -240,11 +248,11 @@ odoc_name.cmi : ../typing/path.cmi ../parsing/longident.cmi \
 odoc_parser.cmi : odoc_types.cmi
 odoc_print.cmi : ../typing/types.cmi
 odoc_search.cmi : odoc_value.cmo odoc_types.cmi odoc_type.cmo \
-    odoc_module.cmo odoc_exception.cmo odoc_class.cmo
+    odoc_module.cmo odoc_extension.cmo odoc_exception.cmo odoc_class.cmo
 odoc_sig.cmi : ../typing/types.cmi ../parsing/parsetree.cmi odoc_types.cmi \
     odoc_type.cmo odoc_name.cmi odoc_module.cmo odoc_env.cmi odoc_class.cmo
 odoc_str.cmi : ../typing/types.cmi odoc_value.cmo odoc_type.cmo \
-    odoc_exception.cmo odoc_class.cmo
+    odoc_extension.cmo odoc_exception.cmo odoc_class.cmo
 odoc_text.cmi : odoc_types.cmi
 odoc_text_parser.cmi : odoc_types.cmi
 odoc_types.cmi : ../parsing/location.cmi
diff --git a/ocamldoc/Makefile b/ocamldoc/Makefile
index f5e47a59bd..564a26bfd9 100644
--- a/ocamldoc/Makefile
+++ b/ocamldoc/Makefile
@@ -76,7 +76,7 @@ INCLUDES_NODEP=	-I $(OCAMLSRCDIR)/stdlib \
 
 INCLUDES=$(INCLUDES_DEP) $(INCLUDES_NODEP)
 
-COMPFLAGS=$(INCLUDES) -warn-error A
+COMPFLAGS=$(INCLUDES) -warn-error A -safe-string
 LINKFLAGS=$(INCLUDES) -nostdlib
 
 CMOFILES= odoc_config.cmo \
@@ -91,6 +91,7 @@ CMOFILES= odoc_config.cmo \
 	odoc_parameter.cmo\
 	odoc_value.cmo\
 	odoc_type.cmo\
+	odoc_extension.cmo\
 	odoc_exception.cmo\
 	odoc_class.cmo\
 	odoc_module.cmo\
diff --git a/ocamldoc/Makefile.nt b/ocamldoc/Makefile.nt
index 158fa7db34..591c194602 100644
--- a/ocamldoc/Makefile.nt
+++ b/ocamldoc/Makefile.nt
@@ -79,6 +79,7 @@ CMOFILES= odoc_config.cmo \
 	odoc_parameter.cmo\
 	odoc_value.cmo\
 	odoc_type.cmo\
+	odoc_extension.cmo\
 	odoc_exception.cmo\
 	odoc_class.cmo\
 	odoc_module.cmo\
diff --git a/ocamldoc/generators/odoc_todo.ml b/ocamldoc/generators/odoc_todo.ml
index 31545feef8..9dbf9f3759 100644
--- a/ocamldoc/generators/odoc_todo.ml
+++ b/ocamldoc/generators/odoc_todo.ml
@@ -18,6 +18,7 @@ module Naming = Odoc_html.Naming
 open Odoc_info.Value
 open Odoc_info.Module
 open Odoc_info.Type
+open Odoc_info.Extension
 open Odoc_info.Exception
 open Odoc_info.Class
 
@@ -115,6 +116,12 @@ struct
         (Odoc_html.Naming.complete_type_target t)
         t.ty_info
 
+    method scan_extension_constructor x =
+      self#gen_if_tag
+        x.xt_name
+        (Odoc_html.Naming.complete_extension_target x)
+        x.xt_type_extension.te_info
+
     method scan_exception e =
       self#gen_if_tag
         e.ex_name
@@ -144,6 +151,7 @@ struct
           | Odoc_module.Element_class c -> self#scan_class c
           | Odoc_module.Element_class_type ct -> self#scan_class_type ct
           | Odoc_module.Element_value v -> self#scan_value v
+          | Odoc_module.Element_type_extension te -> self#scan_type_extension te
           | Odoc_module.Element_exception e -> self#scan_exception e
           | Odoc_module.Element_type t -> self#scan_type t
           | Odoc_module.Element_module_comment t -> self#scan_module_comment t
diff --git a/ocamldoc/odoc_analyse.ml b/ocamldoc/odoc_analyse.ml
index 98f73617df..31328838f4 100644
--- a/ocamldoc/odoc_analyse.ml
+++ b/ocamldoc/odoc_analyse.ml
@@ -33,10 +33,13 @@ let init_path () =
 
 (** Return the initial environment in which compilation proceeds. *)
 let initial_env () =
+  let initial =
+    if !Clflags.unsafe_string then Env.initial_unsafe_string
+    else Env.initial_safe_string
+  in
   try
-    if !Clflags.nopervasives
-    then Env.initial
-    else Env.open_pers_signature "Pervasives" Env.initial
+    if !Clflags.nopervasives then initial else
+    Env.open_pers_signature "Pervasives" initial
   with Not_found ->
     fatal_error "cannot open pervasives.cmi"
 
@@ -53,6 +56,9 @@ let (++) x f = f x
 
 (** Analysis of an implementation file. Returns (Some typedtree) if
    no error occured, else None and an error message is printed.*)
+
+let tool_name = "ocamldoc"
+
 let process_implementation_file ppf sourcefile =
   init_path ();
   let prefixname = Filename.chop_extension sourcefile in
@@ -61,7 +67,10 @@ let process_implementation_file ppf sourcefile =
   let inputfile = preprocess sourcefile in
   let env = initial_env () in
   try
-    let parsetree = Pparse.file Format.err_formatter inputfile Parse.implementation ast_impl_magic_number in
+    let parsetree =
+      Pparse.file ~tool_name Format.err_formatter inputfile
+        Parse.implementation ast_impl_magic_number
+    in
     let typedtree =
       Typemod.type_implementation
         sourcefile prefixname modulename env parsetree
@@ -89,8 +98,11 @@ let process_interface_file ppf sourcefile =
   let modulename = String.capitalize(Filename.basename prefixname) in
   Env.set_unit_name modulename;
   let inputfile = preprocess sourcefile in
-  let ast = Pparse.file Format.err_formatter inputfile Parse.interface ast_intf_magic_number in
-  let sg = Typemod.transl_signature (initial_env()) ast in
+  let ast =
+    Pparse.file ~tool_name Format.err_formatter inputfile
+      Parse.interface ast_intf_magic_number
+  in
+  let sg = Typemod.type_interface (initial_env()) ast in
   Warnings.check_fatal ();
   (ast, sg, inputfile)
 
@@ -318,6 +330,7 @@ let rec remove_module_elements_between_stop keep eles =
           else
             f keep q
       | Odoc_module.Element_value _
+      | Odoc_module.Element_type_extension _
       | Odoc_module.Element_exception _
       | Odoc_module.Element_type _ ->
           if keep then
diff --git a/ocamldoc/odoc_ast.ml b/ocamldoc/odoc_ast.ml
index 3e0cc83b6e..358a71a51c 100644
--- a/ocamldoc/odoc_ast.ml
+++ b/ocamldoc/odoc_ast.ml
@@ -25,6 +25,7 @@ module Name = Odoc_name
 open Odoc_parameter
 open Odoc_value
 open Odoc_type
+open Odoc_extension
 open Odoc_exception
 open Odoc_class
 open Odoc_module
@@ -48,8 +49,8 @@ module Typedtree_search =
       | T of string
       | C of string
       | CT of string
+      | X of string
       | E of string
-      | ER of string
       | P of string
       | IM of string
 
@@ -75,10 +76,13 @@ module Typedtree_search =
             mods
       | Typedtree.Tstr_modtype mtd ->
           Hashtbl.add table (MT (Name.from_ident mtd.mtd_id)) tt
-      | Typedtree.Tstr_exception decl ->
-          Hashtbl.add table (E (Name.from_ident decl.cd_id)) tt
-      | Typedtree.Tstr_exn_rebind er ->
-          Hashtbl.add table (ER (Name.from_ident er.exrb_id)) tt
+      | Typedtree.Tstr_typext te -> begin
+          match te.tyext_constructors with
+            [] -> assert false
+          | ext :: _ -> Hashtbl.add table (X (Name.from_ident ext.ext_id)) tt
+        end
+      | Typedtree.Tstr_exception ext ->
+          Hashtbl.add table (E (Name.from_ident ext.ext_id)) tt
       | Typedtree.Tstr_type ident_type_decl_list ->
           List.iter
             (fun td ->
@@ -129,14 +133,14 @@ module Typedtree_search =
       | (Typedtree.Tstr_modtype mtd) -> mtd
       | _ -> assert false
 
-    let search_exception table name =
-      match Hashtbl.find table (E name) with
-      | (Typedtree.Tstr_exception decl) -> decl
+    let search_extension table name =
+      match Hashtbl.find table (X name) with
+      | (Typedtree.Tstr_typext tyext) -> tyext
       | _ -> assert false
 
-    let search_exception_rebind table name =
-      match Hashtbl.find table (ER name) with
-      | (Typedtree.Tstr_exn_rebind er) -> er.exrb_path
+    let search_exception table name =
+      match Hashtbl.find table (E name) with
+      | (Typedtree.Tstr_exception ext) -> ext
       | _ -> assert false
 
     let search_type_declaration table name =
@@ -679,6 +683,9 @@ module Analyser =
         | (Parsetree.Pcf_initializer exp) ->
             iter acc_inher acc_fields exp.Parsetree.pexp_loc.Location.loc_end.Lexing.pos_cnum q
 
+        | Parsetree.Pcf_attribute _ ->
+            iter acc_inher acc_fields loc.Location.loc_end.Lexing.pos_cnum q
+
         | Parsetree.Pcf_extension _ -> assert false
       in
       iter [] [] last_pos (p_cls.Parsetree.pcstr_fields)
@@ -979,9 +986,17 @@ module Analyser =
                   and n2 = Ident.name ident in
                   n1 = n2
                | _ -> false)
+        | Element_type_extension te ->
+            let l =
+              filter_extension_constructors_with_module_type_constraint
+                te.te_constructors lsig
+            in
+              te.te_constructors <- l;
+              if l <> [] then (fun _ -> true)
+              else (fun _ -> false)
         | Element_exception e ->
             (function
-                Types.Sig_exception (ident,_) ->
+                Types.Sig_typext (ident,_,_) ->
                   let n1 = Name.simple e.ex_name
                   and n2 = Ident.name ident in
                   n1 = n2
@@ -1007,6 +1022,19 @@ module Analyser =
       in
       List.filter pred l
 
+    and filter_extension_constructors_with_module_type_constraint l lsig =
+      let pred xt =
+        List.exists
+          (function
+              Types.Sig_typext (ident, _, _) ->
+                let n1 = Name.simple xt.xt_name
+                and n2 = Ident.name ident in
+                  n1 = n2
+            | _ -> false)
+          lsig
+      in
+        List.filter pred l
+
     (** Analysis of a parse tree structure with a typed tree, to return module elements.*)
     let rec analyse_structure env current_module_name last_pos pos_limit parsetree typedtree =
       print_DEBUG "Odoc_ast:analyse_struture";
@@ -1178,10 +1206,7 @@ module Analyser =
                     | td :: _ -> td.Parsetree.ptype_loc.Location.loc_start.Lexing.pos_cnum
                   in
                   let (maybe_more, name_comment_list) =
-                    Sig.name_comment_from_type_kind
-                    loc_end
-                    pos_limit2
-                    type_decl.Parsetree.ptype_kind
+                    Sig.name_comment_from_type_decl loc_end pos_limit2 type_decl
                   in
                   let tt_type_decl =
                     try Typedtree_search.search_type_declaration table name
@@ -1215,7 +1240,8 @@ module Analyser =
                       ty_manifest =
                         (match tt_type_decl.Types.type_manifest with
                            None -> None
-                         | Some t -> Some (Odoc_env.subst_type new_env t));
+                         | Some t ->
+                           Some (Sig.manifest_structure new_env name_comment_list t));
                       ty_loc = { loc_impl = Some loc ; loc_inter = None } ;
                       ty_code =
                       (
@@ -1238,61 +1264,152 @@ module Analyser =
             let (maybe_more, eles) = f ~first: true 0 loc.Location.loc_start.Lexing.pos_cnum name_typedecl_list in
             (maybe_more, new_env, eles)
 
-      | Parsetree.Pstr_exception excep_decl ->
-          let name = excep_decl.Parsetree.pcd_name in
-          (* a new exception is defined *)
-          let complete_name = Name.concat current_module_name name.txt in
-          (* we get the exception declaration in the typed tree *)
-          let tt_excep_decl =
-            try Typedtree_search.search_exception table name.txt
-            with Not_found ->
-              raise (Failure (Odoc_messages.exception_not_found_in_typedtree complete_name))
+      | Parsetree.Pstr_typext tyext ->
+          (* we get the extension declaration in the typed tree *)
+          let tt_tyext =
+            match tyext.Parsetree.ptyext_constructors with
+              [] -> assert false
+            | ext :: _ ->
+                try
+                  Typedtree_search.search_extension table ext.Parsetree.pext_name.txt
+                with Not_found ->
+                  raise (Failure
+                           (Odoc_messages.extension_not_found_in_typedtree
+                          (Name.concat current_module_name ext.Parsetree.pext_name.txt)))
+          in
+          let new_env =
+            List.fold_left
+              (fun acc_env -> fun {Parsetree.pext_name = { txt = name }} ->
+                let complete_name = Name.concat current_module_name name in
+                  Odoc_env.add_extension acc_env complete_name
+              )
+              env
+              tyext.Parsetree.ptyext_constructors
           in
-          let new_env = Odoc_env.add_exception env complete_name in
           let loc_start = loc.Location.loc_start.Lexing.pos_cnum in
           let loc_end =  loc.Location.loc_end.Lexing.pos_cnum in
-          let new_ex =
+          let new_te =
             {
-              ex_name = complete_name ;
-              ex_info = comment_opt ;
-              ex_args = List.map (fun ctyp ->
-                Odoc_env.subst_type new_env ctyp.ctyp_type)
-                tt_excep_decl.cd_args;
-              ex_alias = None ;
-              ex_loc = { loc_impl = Some loc ; loc_inter = None } ;
-              ex_code =
+              te_info = comment_opt;
+              te_type_name =
+                Odoc_env.full_type_name new_env (Name.from_path tt_tyext.tyext_path);
+              te_type_parameters =
+                List.map (fun (ctyp, _) -> Odoc_env.subst_type new_env ctyp.ctyp_type)  tt_tyext.tyext_params;
+              te_private = tt_tyext.tyext_private;
+              te_constructors = [];
+              te_loc = { loc_impl = Some loc ; loc_inter = None } ;
+              te_code =
                 (
-                 if !Odoc_global.keep_code then
-                   Some (get_string_of_file loc_start loc_end)
-                 else
-                   None
+                  if !Odoc_global.keep_code then
+                    Some (get_string_of_file loc_start loc_end)
+                  else
+                    None
                 ) ;
             }
           in
-          (0, new_env, [ Element_exception new_ex ])
+          let rec analyse_extension_constructors maybe_more exts_acc tt_ext_list =
+              match tt_ext_list with
+                  [] -> (maybe_more, List.rev exts_acc)
+                | tt_ext :: q ->
+                    let complete_name = Name.concat current_module_name tt_ext.ext_name.txt in
+                    let ext_loc_end =  tt_ext.ext_loc.Location.loc_end.Lexing.pos_cnum in
+                    let new_xt =
+                      match tt_ext.ext_kind with
+                          Text_decl(args, ret_type) ->
+                            {
+                              xt_name = complete_name;
+                              xt_args =
+                                List.map (fun ctyp -> Odoc_env.subst_type new_env ctyp.ctyp_type) args;
+                              xt_ret =
+                                may_map (fun ctyp -> Odoc_env.subst_type new_env ctyp.ctyp_type) ret_type;
+                              xt_type_extension = new_te;
+                              xt_alias = None;
+                              xt_loc = { loc_impl = Some tt_ext.ext_loc ; loc_inter = None } ;
+                              xt_text = None;
+                            }
+                        | Text_rebind(path, _) ->
+                            {
+                              xt_name = complete_name;
+                              xt_args = [];
+                              xt_ret = None;
+                              xt_type_extension = new_te;
+                              xt_alias =
+                                Some {
+                                  xa_name = Odoc_env.full_extension_constructor_name env (Name.from_path path);
+                                  xa_xt = None;
+                                };
+                              xt_loc = { loc_impl = Some tt_ext.ext_loc ; loc_inter = None } ;
+                              xt_text = None;
+                            }
+                    in
+                      let pos_limit2 =
+                        match q with
+                          [] -> pos_limit
+                        | next :: _ ->
+                            next.ext_loc.Location.loc_start.Lexing.pos_cnum
+                      in
+                      let s = get_string_of_file ext_loc_end pos_limit2 in
+                      let (maybe_more, comment_opt) =  My_ir.just_after_special !file_name s in
+                        new_xt.xt_text <- comment_opt;
+                        analyse_extension_constructors maybe_more (new_xt :: exts_acc) q
+          in
+            let (maybe_more, exts) = analyse_extension_constructors 0 [] tt_tyext.tyext_constructors in
+              new_te.te_constructors <- exts;
+              (maybe_more, new_env, [ Element_type_extension new_te ])
 
-      | Parsetree.Pstr_exn_rebind {Parsetree.pexrb_name = name} ->
+      | Parsetree.Pstr_exception ext ->
+          let name = ext.Parsetree.pext_name in
           (* a new exception is defined *)
           let complete_name = Name.concat current_module_name name.txt in
-          (* we get the exception rebind in the typed tree *)
-          let tt_path =
-            try Typedtree_search.search_exception_rebind table name.txt
+          (* we get the exception declaration in the typed tree *)
+          let tt_ext =
+            try Typedtree_search.search_exception table name.txt
             with Not_found ->
               raise (Failure (Odoc_messages.exception_not_found_in_typedtree complete_name))
           in
-          let new_env = Odoc_env.add_exception env complete_name in
-          let new_ex =
-            {
-              ex_name = complete_name ;
-              ex_info = comment_opt ;
-              ex_args = [] ;
-              ex_alias = Some { ea_name = (Odoc_env.full_exception_name env (Name.from_path tt_path)) ;
-                                ea_ex = None ; } ;
-              ex_loc = { loc_impl = Some loc ; loc_inter = None } ;
-              ex_code = None ;
-            }
+          let new_env = Odoc_env.add_extension env complete_name in
+          let new_ext =
+            match tt_ext.ext_kind with
+              Text_decl(tt_args, tt_ret_type) ->
+                let loc_start = loc.Location.loc_start.Lexing.pos_cnum in
+                let loc_end =  loc.Location.loc_end.Lexing.pos_cnum in
+                {
+                  ex_name = complete_name ;
+                  ex_info = comment_opt ;
+                  ex_args =
+                    List.map
+                      (fun ctyp -> Odoc_env.subst_type new_env ctyp.ctyp_type)
+                      tt_args;
+                  ex_ret =
+                    Misc.may_map
+                      (fun ctyp -> Odoc_env.subst_type new_env ctyp.ctyp_type)
+                      tt_ret_type;
+                  ex_alias = None ;
+                  ex_loc = { loc_impl = Some loc ; loc_inter = None } ;
+                  ex_code =
+                    (
+                      if !Odoc_global.keep_code then
+                        Some (get_string_of_file loc_start loc_end)
+                      else
+                        None
+                    ) ;
+                }
+            | Text_rebind(tt_path, _) ->
+                {
+                  ex_name = complete_name ;
+                  ex_info = comment_opt ;
+                  ex_args = [] ;
+                  ex_ret = None ;
+                  ex_alias =
+                    Some { ea_name =
+                             Odoc_env.full_extension_constructor_name
+                               env (Name.from_path tt_path) ;
+                           ea_ex = None ; } ;
+                  ex_loc = { loc_impl = Some loc ; loc_inter = None } ;
+                  ex_code = None ;
+                }
           in
-          (0, new_env, [ Element_exception new_ex ])
+            (0, new_env, [ Element_exception new_ext ])
 
       | Parsetree.Pstr_module {Parsetree.pmb_name=name; pmb_expr=module_expr} ->
           (
diff --git a/ocamldoc/odoc_ast.mli b/ocamldoc/odoc_ast.mli
index dc5a2a3ffd..c3db304ea7 100644
--- a/ocamldoc/odoc_ast.mli
+++ b/ocamldoc/odoc_ast.mli
@@ -30,20 +30,15 @@ module Typedtree_search :
          @raise Not_found if the module was not found.*)
       val search_module : tab -> string -> Typedtree.module_expr
 
-      (** This function returns the [Types.module_type] associated to the given module type name,
+      (** This function returns the [Typedtree.module_type] associated to the given module type name,
          in the given table.
          @raise Not_found if the module type was not found.*)
       val search_module_type : tab -> string -> Typedtree.module_type_declaration
 
-      (** This function returns the [Types.exception_declaration] associated to the given exception name,
+      (** This function returns the [Typedtree.type_extension] associated to the given extension name,
          in the given table.
-         @raise Not_found if the exception was not found.*)
-      val search_exception : tab -> string -> Typedtree.constructor_declaration
-
-      (** This function returns the [Path.t] associated to the given exception rebind name,
-         in the table.
-         @raise Not_found if the exception rebind was not found.*)
-      val search_exception_rebind : tab -> string -> Path.t
+         @raise Not_found if the extension was not found.*)
+      val search_extension : tab -> string -> Typedtree.type_extension
 
       (** This function returns the [Typedtree.type_declaration] associated to the given type name,
          in the given table.
@@ -55,7 +50,7 @@ module Typedtree_search :
          @raise Not_found if the class was not found. *)
       val search_class_exp : tab -> string -> (Typedtree.class_expr * (Types.type_expr list))
 
-      (** This function returns the [Types.cltype_declaration] associated to the given class type name,
+      (** This function returns the [Typedtree.class_type_declaration] associated to the given class type name,
          in the given table.
          @raise Not_found if the class type was not found. *)
       val search_class_type_declaration : tab -> string -> Typedtree.class_type_declaration
diff --git a/ocamldoc/odoc_cross.ml b/ocamldoc/odoc_cross.ml
index 70c3c0eb26..28e6ae5bf2 100644
--- a/ocamldoc/odoc_cross.ml
+++ b/ocamldoc/odoc_cross.ml
@@ -15,6 +15,7 @@
 module Name = Odoc_name
 open Odoc_module
 open Odoc_class
+open Odoc_extension
 open Odoc_exception
 open Odoc_types
 open Odoc_value
@@ -60,6 +61,7 @@ module P_alias =
     let p_recfield _ _ _ = false
     let p_const _ _ _ = false
     let p_type t _ = (false, false)
+    let p_extension x _ = x.xt_alias <> None
     let p_exception e _ = e.ex_alias <> None
     let p_attribute a _ = false
     let p_method m _ = false
@@ -79,6 +81,9 @@ let (module_aliases : (Name.t, Name.t * alias_state) Hashtbl.t) = Hashtbl.create
 (** Couples of module or module type name aliases. *)
 let module_and_modtype_aliases = Hashtbl.create 13;;
 
+(** Couples of extension name aliases. *)
+let extension_aliases = Hashtbl.create 13;;
+
 (** Couples of exception name aliases. *)
 let exception_aliases = Hashtbl.create 13;;
 
@@ -102,6 +107,15 @@ let rec build_alias_list = function
        | _ -> ()
       );
       build_alias_list q
+  | (Odoc_search.Res_extension x) :: q ->
+      (
+       match x.xt_alias with
+         None -> ()
+       | Some xa ->
+           Hashtbl.add extension_aliases
+             x.xt_name (xa.xa_name,Alias_to_resolve)
+      );
+      build_alias_list q
   | (Odoc_search.Res_exception e) :: q ->
       (
        match e.ex_alias with
@@ -119,6 +133,7 @@ let rec build_alias_list = function
 let get_alias_names module_list =
   Hashtbl.clear module_aliases;
   Hashtbl.clear module_and_modtype_aliases;
+  Hashtbl.clear extension_aliases;
   Hashtbl.clear exception_aliases;
   build_alias_list (Search_alias.search module_list 0)
 
@@ -183,6 +198,7 @@ let kind_name_exists kind =
     | 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_extension -> (fun e -> match e with Odoc_search.Res_extension _ -> 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)
@@ -200,6 +216,7 @@ 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 extension_exists = kind_name_exists RK_extension
 let exception_exists = kind_name_exists RK_exception
 let attribute_exists = kind_name_exists RK_attribute
 let method_exists = kind_name_exists RK_method
@@ -238,6 +255,14 @@ let lookup_class_type name =
   | Odoc_search.Res_class_type c -> c
   | _ -> assert false
 
+let lookup_extension name =
+  match List.find
+      (fun k -> match k with Odoc_search.Res_extension _ -> true | _ -> false)
+      (get_known_elements name)
+  with
+  | Odoc_search.Res_extension x -> x
+  | _ -> assert false
+
 let lookup_exception name =
   match List.find
       (fun k -> match k with Odoc_search.Res_exception _ -> true | _ -> false)
@@ -262,6 +287,8 @@ class scan =
     method! scan_type_pre t =
       add_known_element t.ty_name (Odoc_search.Res_type t);
       true
+    method! scan_extension_constructor x =
+      add_known_element x.xt_name (Odoc_search.Res_extension x)
     method! scan_exception e =
       add_known_element e.ex_name (Odoc_search.Res_exception e)
     method! scan_attribute a =
@@ -298,6 +325,7 @@ type not_found_name =
   | NF_c of Name.t
   | NF_ct of Name.t
   | NF_cct of Name.t
+  | NF_xt of Name.t
   | NF_ex of Name.t
 
 (** Functions to find and associate aliases elements. *)
@@ -466,6 +494,7 @@ and associate_in_module_element module_list m_name (acc_b_modif, acc_incomplete_
    | Element_class cl -> associate_in_class module_list (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found) cl
    | Element_class_type ct -> associate_in_class_type module_list (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found) ct
    | Element_value _ -> (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found)
+   | Element_type_extension te -> associate_in_type_extension module_list (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found) te
    | Element_exception ex ->
        (
         match ex.ex_alias with
@@ -617,6 +646,29 @@ and associate_in_class_type module_list (acc_b_modif, acc_incomplete_top_module_
   in
   iter_kind (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found) ct.clt_kind
 
+and associate_in_type_extension module_list (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found) te =
+  List.fold_left
+    (fun (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found) xt ->
+       match xt.xt_alias with
+           None -> (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found)
+         | Some xa ->
+             match xa.xa_xt with
+                 Some _ ->
+                   (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found)
+               | None ->
+                   let xt_opt =
+                     try Some (lookup_extension xa.xa_name)
+                     with Not_found -> None
+                   in
+                     match xt_opt with
+                         None -> (acc_b_modif, (Name.head xt.xt_name) :: acc_incomplete_top_module_names, (NF_xt xa.xa_name) :: acc_names_not_found)
+                       | Some x ->
+                           xa.xa_xt <- Some x ;
+                           (true, acc_incomplete_top_module_names, acc_names_not_found))
+    (acc_b_modif, acc_incomplete_top_module_names, acc_names_not_found)
+    te.te_constructors
+
+
 (*************************************************************)
 (** Association of types to elements referenced in comments .*)
 
@@ -630,6 +682,7 @@ let not_found_of_kind kind name =
   | RK_class_type -> Odoc_messages.cross_class_type_not_found
   | RK_value -> Odoc_messages.cross_value_not_found
   | RK_type -> Odoc_messages.cross_type_not_found
+  | RK_extension -> Odoc_messages.cross_extension_not_found
   | RK_exception -> Odoc_messages.cross_exception_not_found
   | RK_attribute -> Odoc_messages.cross_attribute_not_found
   | RK_method -> Odoc_messages.cross_method_not_found
@@ -687,6 +740,7 @@ let rec assoc_comments_text_elements parent_name module_list t_ele =
                  | Odoc_search.Res_class_type ct -> (ct.clt_name, RK_class_type)
                  | Odoc_search.Res_value v -> (v.val_name, RK_value)
                  | Odoc_search.Res_type t -> (t.ty_name, RK_type)
+                 | Odoc_search.Res_extension x -> (x.xt_name, RK_extension)
                  | Odoc_search.Res_exception e -> (e.ex_name, RK_exception)
                  | Odoc_search.Res_attribute a -> (a.att_value.val_name, RK_attribute)
                  | Odoc_search.Res_method m -> (m.met_value.val_name, RK_method)
@@ -747,6 +801,7 @@ let rec assoc_comments_text_elements parent_name module_list t_ele =
                    | RK_class_type -> class_type_exists
                    | RK_value -> value_exists
                    | RK_type -> type_exists
+                   | RK_extension -> extension_exists
                    | RK_exception -> exception_exists
                    | RK_attribute -> attribute_exists
                    | RK_method -> method_exists
@@ -817,6 +872,8 @@ let rec assoc_comments_module_element parent_name module_list m_ele =
       Element_class_type (assoc_comments_class_type module_list ct)
   | Element_value v ->
       Element_value (assoc_comments_value module_list v)
+  | Element_type_extension te ->
+      Element_type_extension (assoc_comments_type_extension parent_name module_list te)
   | Element_exception e ->
       Element_exception (assoc_comments_exception module_list e)
   | Element_type t ->
@@ -938,6 +995,15 @@ and assoc_comments_value module_list v =
   assoc_comments_parameter_list parent module_list v.val_parameters;
   v
 
+and assoc_comments_extension_constructor module_list x =
+  let parent = Name.father x.xt_name in
+  x.xt_text <- ao (assoc_comments_info parent module_list) x.xt_text
+
+and assoc_comments_type_extension parent_name module_list te =
+  te.te_info <- ao (assoc_comments_info parent_name module_list) te.te_info;
+  List.iter (assoc_comments_extension_constructor module_list) te.te_constructors;
+  te
+
 and assoc_comments_exception module_list e =
   let parent = Name.father e.ex_name in
   e.ex_info <- ao (assoc_comments_info parent module_list) e.ex_info ;
@@ -956,6 +1022,7 @@ and assoc_comments_type module_list t =
       List.iter
         (fun rf -> rf.rf_text <- ao (assoc_comments_info parent module_list) rf.rf_text)
         fl
+  | Type_open -> ()
   );
   t
 
@@ -1018,6 +1085,7 @@ let associate module_list =
               | NF_c n -> Odoc_messages.cross_class_not_found n
               | NF_ct n -> Odoc_messages.cross_class_type_not_found n
               | NF_cct n -> Odoc_messages.cross_class_or_class_type_not_found n
+              | NF_xt n -> Odoc_messages.cross_extension_not_found n
               | NF_ex n -> Odoc_messages.cross_exception_not_found n
              );
          )
diff --git a/ocamldoc/odoc_dep.ml b/ocamldoc/odoc_dep.ml
index f2934ee3e0..c2949d7334 100644
--- a/ocamldoc/odoc_dep.ml
+++ b/ocamldoc/odoc_dep.ml
@@ -167,11 +167,19 @@ let type_deps t =
           ignore (Str.global_substitute re f s)
         )
         rl
+  | T.Type_open -> ()
   );
 
   (match t.T.ty_manifest with
     None -> ()
-  | Some e ->
+  | Some (T.Object_type fields) ->
+      List.iter
+        (fun r ->
+          let s = Odoc_print.string_of_type_expr r.T.of_type in
+          ignore (Str.global_substitute re f s)
+          )
+        fields
+  | Some (T.Other e) ->
       let s = Odoc_print.string_of_type_expr e in
       ignore (Str.global_substitute re f s)
   );
diff --git a/ocamldoc/odoc_env.ml b/ocamldoc/odoc_env.ml
index 02d1e3a211..3e05905856 100644
--- a/ocamldoc/odoc_env.ml
+++ b/ocamldoc/odoc_env.ml
@@ -26,7 +26,7 @@ type env = {
     env_classes : env_element list ;
     env_modules : env_element list ;
     env_module_types : env_element list ;
-    env_exceptions : env_element list ;
+    env_extensions : env_element list ;
   }
 
 let empty = {
@@ -36,7 +36,7 @@ let empty = {
   env_classes = [] ;
   env_modules = [] ;
   env_module_types = [] ;
-  env_exceptions = [] ;
+  env_extensions = [] ;
   }
 
 (** Add a signature to an environment.  *)
@@ -52,7 +52,7 @@ let rec add_signature env root ?rel signat =
     match item with
       Types.Sig_value (ident, _) -> { env with env_values = (rel_name ident, qualify ident) :: env.env_values }
     | Types.Sig_type (ident,_,_) -> { env with env_types = (rel_name ident, qualify ident) :: env.env_types }
-    | Types.Sig_exception (ident, _) -> { env with env_exceptions = (rel_name ident, qualify ident) :: env.env_exceptions }
+    | Types.Sig_typext (ident, _, _) -> { env with env_extensions = (rel_name ident, qualify ident) :: env.env_extensions }
     | Types.Sig_module (ident, md, _) ->
         let env2 =
           match md.Types.md_type with (* A VOIR : le cas ou c'est un identificateur, dans ce cas on n'a pas de signature *)
@@ -77,9 +77,9 @@ let rec add_signature env root ?rel signat =
   in
   List.fold_left f env signat
 
-let add_exception env full_name =
+let add_extension env full_name =
   let simple_name = Name.simple full_name in
-  { env with env_exceptions = (simple_name, full_name) :: env.env_exceptions }
+  { env with env_extensions = (simple_name, full_name) :: env.env_extensions }
 
 let add_type env full_name =
   let simple_name = Name.simple full_name in
@@ -146,11 +146,11 @@ let full_value_name env n =
   try List.assoc n env.env_values
   with Not_found -> n
 
-let full_exception_name env n =
-  try List.assoc n env.env_exceptions
+let full_extension_constructor_name env n =
+  try List.assoc n env.env_extensions
   with Not_found ->
-    print_DEBUG ("Exception "^n^" not found with env=");
-    List.iter (fun (sn, fn) -> print_DEBUG ("("^sn^", "^fn^")")) env.env_exceptions;
+    print_DEBUG ("Extension "^n^" not found with env=");
+    List.iter (fun (sn, fn) -> print_DEBUG ("("^sn^", "^fn^")")) env.env_extensions;
     n
 
 let full_class_name env n =
diff --git a/ocamldoc/odoc_env.mli b/ocamldoc/odoc_env.mli
index cafdd52ed9..4e1e8606d7 100644
--- a/ocamldoc/odoc_env.mli
+++ b/ocamldoc/odoc_env.mli
@@ -22,7 +22,7 @@ val empty : env
 (** Extending an environment *)
 
 val add_signature : env -> string -> ?rel:string -> Types.signature -> env
-val add_exception : env -> Odoc_name.t -> env
+val add_extension : env -> Odoc_name.t -> env
 val add_type : env -> Odoc_name.t -> env
 val add_value : env -> Odoc_name.t -> env
 val add_module : env -> Odoc_name.t -> env
@@ -48,8 +48,8 @@ val full_type_name : env -> Odoc_name.t -> Odoc_name.t
 (** Get the fully qualified value name from a name.*)
 val full_value_name : env -> Odoc_name.t -> Odoc_name.t
 
-(** Get the fully qualified exception name from a name.*)
-val full_exception_name : env -> Odoc_name.t -> Odoc_name.t
+(** Get the fully qualified extension name from a name.*)
+val full_extension_constructor_name : env -> Odoc_name.t -> Odoc_name.t
 
 (** Get the fully qualified class name from a name.*)
 val full_class_name : env -> Odoc_name.t -> Odoc_name.t
diff --git a/ocamldoc/odoc_exception.ml b/ocamldoc/odoc_exception.ml
index a62cb7b7d5..b0e21196cc 100644
--- a/ocamldoc/odoc_exception.ml
+++ b/ocamldoc/odoc_exception.ml
@@ -23,6 +23,7 @@ and t_exception = {
     ex_name : Name.t ;
     mutable ex_info : Odoc_types.info option ; (** optional user information *)
     ex_args : Types.type_expr list ; (** the types of the parameters *)
+    ex_ret: Types.type_expr option ; (** the optional return type *)
     ex_alias : exception_alias option ;
     mutable ex_loc : Odoc_types.location ;
     mutable ex_code : string option ;
diff --git a/ocamldoc/odoc_extension.ml b/ocamldoc/odoc_extension.ml
new file mode 100644
index 0000000000..0a08419530
--- /dev/null
+++ b/ocamldoc/odoc_extension.ml
@@ -0,0 +1,46 @@
+(***********************************************************************)
+(*                             OCamldoc                                *)
+(*                                                                     *)
+(*            Maxence Guesdon, projet Cristal, INRIA Rocquencourt      *)
+(*                                                                     *)
+(*  Copyright 2001 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$ *)
+
+(** Representation and manipulation of type extensions. *)
+
+module Name = Odoc_name
+
+type private_flag = Asttypes.private_flag =
+    Private | Public
+
+type extension_alias = {
+    xa_name : Name.t ;
+    mutable xa_xt : t_extension_constructor option ;
+  }
+
+and t_extension_constructor = {
+    xt_name : Name.t ;
+    xt_args: Types.type_expr list ; (** the types of the parameters *)
+    xt_ret: Types.type_expr option ; (** the optional return type of the extension *)
+    xt_type_extension: t_type_extension ; (** the type extension containing this constructor *)
+    xt_alias: extension_alias option ;
+    mutable xt_loc: Odoc_types.location ;
+    mutable xt_text: Odoc_types.info option ; (** optional user description *)
+  }
+
+and t_type_extension = {
+    mutable te_info : Odoc_types.info option ; (** optional user information *)
+    te_type_name : Name.t;
+    te_type_parameters : Types.type_expr list;
+    te_private : private_flag;
+    mutable te_constructors: t_extension_constructor list;
+    mutable te_loc : Odoc_types.location ;
+    mutable te_code : string option ;
+  }
+
+let extension_constructors te = te.te_constructors
diff --git a/ocamldoc/odoc_html.ml b/ocamldoc/odoc_html.ml
index 3bee9838b6..96f2dfc7e5 100644
--- a/ocamldoc/odoc_html.ml
+++ b/ocamldoc/odoc_html.ml
@@ -18,6 +18,7 @@ open Odoc_info
 open Parameter
 open Value
 open Type
+open Extension
 open Exception
 open Class
 open Module
@@ -42,6 +43,9 @@ module Naming =
     (** The prefix for functions marks. *)
     let mark_function = "FUN"
 
+    (** The prefix for extensions marks. *)
+    let mark_extension = "EXTENSION"
+
     (** The prefix for exceptions marks. *)
     let mark_exception = "EXCEPTION"
 
@@ -100,6 +104,10 @@ module Naming =
     let recfield_target t f = target mark_type_elt
       (Printf.sprintf "%s.%s" (Name.simple t.ty_name) f.rf_name)
 
+    (** Return the link target for the given object field. *)
+    let objfield_target t f = target mark_type_elt
+      (Printf.sprintf "%s.%s" (Name.simple t.ty_name) f.of_name)
+
     (** Return the complete link target for the given type. *)
     let complete_type_target t = complete_target mark_type t.ty_name
 
@@ -110,6 +118,12 @@ module Naming =
 
     let complete_const_target = complete_recfield_target
 
+    (** Return the link target for the given extension. *)
+    let extension_target x = target mark_extension (Name.simple x.xt_name)
+
+    (** Return the complete link target for the given extension. *)
+    let complete_extension_target x = complete_target mark_extension x.xt_name
+
     (** Return the link target for the given exception. *)
     let exception_target e = target mark_exception (Name.simple e.ex_name)
 
@@ -261,9 +275,9 @@ class virtual text =
       List.iter (self#html_of_text_element b) t
 
     (** Print the html code for the [text_element] in parameter. *)
-    method html_of_text_element b te =
+    method html_of_text_element b txt =
       print_DEBUG "text::html_of_text_element";
-      match te with
+      match txt with
       | Odoc_info.Raw s -> self#html_of_Raw b s
       | Odoc_info.Code s -> self#html_of_Code b s
       | Odoc_info.CodePre s -> self#html_of_CodePre b s
@@ -454,6 +468,7 @@ class virtual text =
                 (html_file, h name)
             | Odoc_info.RK_value -> (Naming.complete_target Naming.mark_value name, h name)
             | Odoc_info.RK_type -> (Naming.complete_target Naming.mark_type name, h name)
+            | Odoc_info.RK_extension -> (Naming.complete_target Naming.mark_extension name, h name)
             | Odoc_info.RK_exception -> (Naming.complete_target Naming.mark_exception name, h name)
             | Odoc_info.RK_attribute -> (Naming.complete_target Naming.mark_attribute name, h name)
             | Odoc_info.RK_method -> (Naming.complete_target Naming.mark_method name, h name)
@@ -515,6 +530,7 @@ class virtual text =
       in
       bp b "<ul class=\"indexlist\">\n";
       index_if_not_empty self#list_types self#index_types Odoc_messages.index_of_types;
+      index_if_not_empty self#list_extensions self#index_extensions Odoc_messages.index_of_extensions;
       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;
@@ -527,6 +543,8 @@ class virtual text =
 
     method virtual list_types : Odoc_info.Type.t_type list
     method virtual index_types : string
+    method virtual list_extensions : Odoc_info.Extension.t_extension_constructor list
+    method virtual index_extensions : 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
@@ -888,6 +906,8 @@ class html =
     method index_values = Printf.sprintf "%s_values.html" self#index_prefix
     (** The file for the index of types. *)
     method index_types = Printf.sprintf "%s_types.html" self#index_prefix
+    (** The file for the index of extensions. *)
+    method index_extensions = Printf.sprintf "%s_extensions.html" self#index_prefix
     (** The file for the index of exceptions. *)
     method index_exceptions = Printf.sprintf "%s_exceptions.html" self#index_prefix
     (** The file for the index of attributes. *)
@@ -913,6 +933,9 @@ class html =
     (** The list of values. Filled in the [generate] method. *)
     val mutable list_values = []
     method list_values = list_values
+    (** The list of extensions. Filled in the [generate] method. *)
+    val mutable list_extensions = []
+    method list_extensions = list_extensions
     (** The list of exceptions. Filled in the [generate] method. *)
     val mutable list_exceptions = []
     method list_exceptions = list_exceptions
@@ -1012,6 +1035,7 @@ class html =
              )
         );
         link_if_not_empty self#list_types Odoc_messages.index_of_types self#index_types;
+        link_if_not_empty self#list_extensions Odoc_messages.index_of_extensions self#index_extensions;
         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;
@@ -1321,7 +1345,7 @@ class html =
       self#html_of_module_type_kind b father p.mp_kind;
       self#html_of_text b [ Code (") "^s_arrow)]
 
-    method html_of_module_element b father ele =
+    method html_of_module_element b m_name ele =
       match ele with
         Element_module m ->
           self#html_of_module b ~complete: false m
@@ -1335,6 +1359,8 @@ class html =
           self#html_of_class_type b ~complete: false ct
       | Element_value v ->
           self#html_of_value b v
+      | Element_type_extension te ->
+          self#html_of_type_extension b m_name te
       | Element_exception e ->
           self#html_of_exception b e
       | Element_type t ->
@@ -1424,6 +1450,84 @@ class html =
          self#html_of_described_parameter_list b (Name.father v.val_name) v.val_parameters
       )
 
+    (** Print html code for a type extension. *)
+    method html_of_type_extension b m_name te =
+      Odoc_info.reset_type_names ();
+      bs b "<pre><code>";
+      bs b ((self#keyword "type")^" ");
+      let s = Odoc_info.string_of_type_extension_param_list te 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>";
+      (match te.te_type_parameters with [] -> () | _ -> bs b " ");
+      bs b (self#create_fully_qualified_idents_links m_name te.te_type_name);
+      bs b " += ";
+      if te.te_private = Asttypes.Private then bs b "private ";
+      bs b "</code></pre>";
+      bs b "<table class=\"typetable\">\n";
+      let print_one x =
+        let father = Name.father x.xt_name in
+        bs b "<tr>\n<td align=\"left\" valign=\"top\" >\n";
+        bs b "<code>";
+        bs b (self#keyword "|");
+        bs b "</code></td>\n<td align=\"left\" valign=\"top\" >\n";
+        bs b "<code>";
+        bp b "<span id=\"%s\">%s</span>"
+          (Naming.extension_target x)
+          (Name.simple x.xt_name);
+        (
+          match x.xt_args, x.xt_ret with
+              [], None -> ()
+            | l,None ->
+                bs b (" " ^ (self#keyword "of") ^ " ");
+                self#html_of_type_expr_list ~par: false b father " * " l;
+            | [],Some r ->
+                bs b (" " ^ (self#keyword ":") ^ " ");
+                self#html_of_type_expr b father r;
+            | l,Some r ->
+                bs b (" " ^ (self#keyword ":") ^ " ");
+                self#html_of_type_expr_list ~par: false b father " * " l;
+                bs b (" " ^ (self#keyword "->") ^ " ");
+                self#html_of_type_expr b father r;
+        );
+        (
+            match x.xt_alias with
+              None -> ()
+            | Some xa ->
+                bs b " = ";
+                (
+                  match xa.xa_xt with
+                    None -> bs b xa.xa_name
+                  | Some x ->
+                      bp b "<a href=\"%s\">%s</a>" (Naming.complete_extension_target x) x.xt_name
+                )
+        );
+        bs b "</code></td>\n";
+        (
+          match x.xt_text with
+              None -> ()
+            | Some t ->
+                bs b "<td class=\"typefieldcomment\" align=\"left\" valign=\"top\" >";
+                bs b "<code>";
+                bs b "(*";
+                bs b "</code></td>";
+                bs b "<td class=\"typefieldcomment\" align=\"left\" valign=\"top\" >";
+                self#html_of_info b (Some t);
+                bs b "</td>";
+                bs b "<td class=\"typefieldcomment\" align=\"left\" valign=\"bottom\" >";
+                bs b "<code>";
+                bs b "*)";
+                bs b "</code></td>";
+        );
+        bs b "\n</tr>"
+      in
+        print_concat b "\n" print_one te.te_constructors;
+        bs b "</table>\n";
+        bs b "\n";
+        self#html_of_info b te.te_info;
+        bs b "\n"
+
     (** Print html code for an exception. *)
     method html_of_exception b e =
       Odoc_info.reset_type_names ();
@@ -1434,12 +1538,21 @@ class html =
       bs b (Name.simple e.ex_name);
       bs b "</span>";
       (
-       match e.ex_args with
-         [] -> ()
-       | _ ->
-           bs b (" "^(self#keyword "of")^" ");
-           self#html_of_type_expr_list
-             ~par: false b (Name.father e.ex_name) " * " e.ex_args
+        match e.ex_args, e.ex_ret with
+          [], None -> ()
+        | l,None ->
+            bs b (" "^(self#keyword "of")^" ");
+            self#html_of_type_expr_list
+                   ~par: false b (Name.father e.ex_name) " * " e.ex_args
+        | [],Some r ->
+            bs b (" " ^ (self#keyword ":") ^ " ");
+            self#html_of_type_expr b (Name.father e.ex_name) r;
+        | l,Some r ->
+            bs b (" " ^ (self#keyword ":") ^ " ");
+            self#html_of_type_expr_list
+                   ~par: false b (Name.father e.ex_name) " * " l;
+            bs b (" " ^ (self#keyword "->") ^ " ");
+            self#html_of_type_expr b (Name.father e.ex_name) r;
       );
       (
        match e.ex_alias with
@@ -1460,12 +1573,32 @@ class html =
     method html_of_type b t =
       Odoc_info.reset_type_names ();
       let father = Name.father t.ty_name in
+      let print_field_prefix () =
+        bs b "<tr>\n<td align=\"left\" valign=\"top\" >\n";
+        bs b "<code>&nbsp;&nbsp;</code>";
+        bs b "</td>\n<td align=\"left\" valign=\"top\" >\n";
+        bs b "<code>";
+      in
+      let print_field_comment = function
+        | None -> ()
+        | Some t ->
+            bs b "<td class=\"typefieldcomment\" align=\"left\" valign=\"top\" >";
+            bs b "<code>";
+            bs b "(*";
+            bs b "</code></td>";
+            bs b "<td class=\"typefieldcomment\" align=\"left\" valign=\"top\" >";
+            self#html_of_info b (Some t);
+            bs b "</td><td class=\"typefieldcomment\" align=\"left\" valign=\"bottom\" >";
+            bs b "<code>*)</code></td>"
+      in
       bs b
         (match t.ty_manifest, t.ty_kind with
-          None, Type_abstract -> "\n<pre>"
+          None, Type_abstract
+        | None, Type_open -> "\n<pre>"
         | None, Type_variant _
         | None, Type_record _ -> "\n<pre><code>"
-        | Some _, Type_abstract -> "\n<pre>"
+        | Some _, Type_abstract
+        | Some _, Type_open -> "\n<pre>"
         | Some _, Type_variant _
         | Some _, Type_record _ -> "\n<pre>"
         );
@@ -1479,7 +1612,25 @@ class html =
       (
        match t.ty_manifest with
          None -> ()
-       | Some typ ->
+       | Some (Object_type fields) ->
+           bs b "= ";
+           if priv then bs b "private ";
+           bs b "&lt;</pre>";
+           bs b "<table class=\"typetable\">\n" ;
+           let print_one f =
+             print_field_prefix () ;
+             bp b "<span id=\"%s\">%s</span>&nbsp;: "
+               (Naming.objfield_target t f)
+               f.of_name;
+             self#html_of_type_expr b father f.of_type;
+             bs b ";</code></td>\n";
+             print_field_comment f.of_text ;
+             bs b "\n</tr>"
+           in
+           print_concat b "\n" print_one fields;
+           bs b "</table>\n>\n";
+           bs b " "
+       | Some (Other typ) ->
            bs b "= ";
            if priv then bs b "private ";
            self#html_of_type_expr b father typ;
@@ -1582,6 +1733,9 @@ class html =
           in
           print_concat b "\n" print_one l;
           bs b "</table>\n}\n"
+      | Type_open ->
+          bs b "= ..";
+          bs b "</pre>"
       );
       bs b "\n";
       self#html_of_info b t.ty_info;
@@ -2313,7 +2467,7 @@ class html =
         bs b "<hr width=\"100%\">\n";
         (* module elements *)
         List.iter
-          (self#html_of_module_element b (Name.father mt.mt_name))
+          (self#html_of_module_element b mt.mt_name)
           (Module.module_type_elements mt);
 
         bs b "</body></html>";
@@ -2396,7 +2550,7 @@ class html =
 
         (* module elements *)
         List.iter
-          (self#html_of_module_element b (Name.father modu.m_name))
+          (self#html_of_module_element b modu.m_name)
           (Module.module_elements modu);
 
         bs b "</body></html>";
@@ -2474,6 +2628,16 @@ class html =
         Odoc_messages.index_of_values
         self#index_values
 
+    (** Generate the extensions index in the file [index_extensions.html]. *)
+    method generate_extensions_index module_list =
+      self#generate_elements_index
+        self#list_extensions
+        (fun x -> x.xt_name)
+        (fun x -> x.xt_type_extension.te_info)
+        (fun x -> Naming.complete_extension_target x)
+        Odoc_messages.index_of_extensions
+        self#index_extensions
+
     (** Generate the exceptions index in the file [index_exceptions.html]. *)
     method generate_exceptions_index module_list =
       self#generate_elements_index
@@ -2561,6 +2725,7 @@ class html =
       self#init_style ;
       (* init the lists of elements *)
       list_values <- Odoc_info.Search.values module_list ;
+      list_extensions <- Odoc_info.Search.extensions module_list ;
       list_exceptions <- Odoc_info.Search.exceptions module_list ;
       list_types <- Odoc_info.Search.types module_list ;
       list_attributes <- Odoc_info.Search.attributes module_list ;
@@ -2612,6 +2777,7 @@ class html =
       try
         self#generate_index module_list;
         self#generate_values_index module_list ;
+        self#generate_extensions_index module_list ;
         self#generate_exceptions_index module_list ;
         self#generate_types_index module_list ;
         self#generate_attributes_index module_list ;
diff --git a/ocamldoc/odoc_info.ml b/ocamldoc/odoc_info.ml
index 4a6c214190..c576e1000b 100644
--- a/ocamldoc/odoc_info.ml
+++ b/ocamldoc/odoc_info.ml
@@ -19,6 +19,7 @@ type ref_kind = Odoc_types.ref_kind =
   | RK_class_type
   | RK_value
   | RK_type
+  | RK_extension
   | RK_exception
   | RK_attribute
   | RK_method
@@ -90,6 +91,7 @@ let dummy_loc = { loc_impl = None ; loc_inter = None }
 
 module Name = Odoc_name
 module Parameter = Odoc_parameter
+module Extension = Odoc_extension
 module Exception = Odoc_exception
 module Type = Odoc_type
 module Value = Odoc_value
@@ -128,6 +130,8 @@ let string_of_type_list ?par sep type_list = Odoc_str.string_of_type_list ?par s
 
 let string_of_type_param_list t = Odoc_str.string_of_type_param_list t
 
+let string_of_type_extension_param_list te = Odoc_str.string_of_type_extension_param_list te
+
 let string_of_class_type_param_list l = Odoc_str.string_of_class_type_param_list l
 
 let string_of_module_type = Odoc_print.string_of_module_type
@@ -140,6 +144,8 @@ let string_of_info i = Odoc_misc.string_of_info i
 
 let string_of_type t = Odoc_str.string_of_type t
 
+let string_of_type_extension te = Odoc_str.string_of_type_extension te
+
 let string_of_exception e = Odoc_str.string_of_exception e
 
 let string_of_value v = Odoc_str.string_of_value v
@@ -290,6 +296,7 @@ module Search =
         | Res_class_type of Class.t_class_type
         | Res_value of Value.t_value
         | Res_type of Type.t_type
+        | Res_extension of Extension.t_extension_constructor
         | Res_exception of Exception.t_exception
         | Res_attribute of Value.t_attribute
         | Res_method of Value.t_method
@@ -302,6 +309,7 @@ module Search =
     let search_by_name = Odoc_search.Search_by_name.search
 
     let values = Odoc_search.values
+    let extensions = Odoc_search.extensions
     let exceptions = Odoc_search.exceptions
     let types = Odoc_search.types
     let attributes = Odoc_search.attributes
diff --git a/ocamldoc/odoc_info.mli b/ocamldoc/odoc_info.mli
index 76e28df64b..e9a9705c7f 100644
--- a/ocamldoc/odoc_info.mli
+++ b/ocamldoc/odoc_info.mli
@@ -20,6 +20,7 @@ type ref_kind = Odoc_types.ref_kind =
   | RK_class_type
   | RK_value
   | RK_type
+  | RK_extension
   | RK_exception
   | RK_attribute
   | RK_method
@@ -169,6 +170,47 @@ module Parameter :
     val type_by_name : parameter -> string -> Types.type_expr
   end
 
+(** Representation and manipulation of extensions. *)
+module Extension :
+  sig
+    type private_flag = Odoc_extension.private_flag =
+      Private | Public
+
+    (** Used when the extension is a rebind of another extension,
+       when we have [extension Xt = Target_xt].*)
+    type extension_alias = Odoc_extension.extension_alias =
+        {
+          xa_name : Name.t ; (** The complete name of the target extension. *)
+          mutable xa_xt : t_extension_constructor option ; (** The target extension, if we found it.*)
+        }
+
+    and t_extension_constructor = Odoc_extension.t_extension_constructor =
+        {
+          xt_name : Name.t ;
+          xt_args: Types.type_expr list ; (** the types of the parameters *)
+          xt_ret: Types.type_expr option ; (** the optional return type of the extension *)
+          xt_type_extension: t_type_extension ; (** the type extension containing this constructor *)
+          xt_alias: extension_alias option ; (** [None] when the extension is not a rebind. *)
+          mutable xt_loc: Odoc_types.location ;
+          mutable xt_text: Odoc_types.info option ; (** optional user description *)
+        }
+
+    and t_type_extension = Odoc_extension.t_type_extension =
+        {
+          mutable te_info : info option ; (** Information found in the optional associated comment. *)
+          te_type_name : Name.t ; (** The type of the extension *)
+          te_type_parameters : Types.type_expr list;
+          te_private : private_flag ;
+          mutable te_constructors: t_extension_constructor list;
+          mutable te_loc : location ;
+          mutable te_code : string option ;
+        }
+
+    (** Access to the extensions in a group. *)
+    val extension_constructors : t_type_extension -> t_extension_constructor list
+
+  end
+
 (** Representation and manipulation of exceptions. *)
 module Exception :
   sig
@@ -185,6 +227,7 @@ module Exception :
           ex_name : Name.t ;
           mutable ex_info : info option ; (** Information found in the optional associated comment. *)
           ex_args : Types.type_expr list ; (** The types of the parameters. *)
+          ex_ret : Types.type_expr option ; (** The the optional return type of the exception. *)
           ex_alias : exception_alias option ; (** [None] when the exception is not a rebind. *)
           mutable ex_loc : location ;
           mutable ex_code : string option ;
@@ -222,6 +265,17 @@ module Type :
                    (** constructors *)
       | Type_record of record_field list
                    (** fields *)
+      | Type_open (** Type is open *)
+
+    type object_field = Odoc_type.object_field = {
+      of_name : string ;
+      of_type : Types.type_expr ;
+      mutable of_text : Odoc_types.info option ; (** optional user description *)
+    }
+
+    type type_manifest = Odoc_type.type_manifest =
+      | Other of Types.type_expr (** Type manifest directly taken from Typedtre. *)
+      | Object_type of object_field list
 
     (** Representation of a type. *)
     type t_type = Odoc_type.t_type =
@@ -232,7 +286,7 @@ module Type :
                     (** type parameters: (type, covariant, contravariant) *)
           ty_kind : type_kind; (** Type kind. *)
           ty_private : private_flag; (** Private or public type. *)
-          ty_manifest : Types.type_expr option; (** Type manifest. *)
+          ty_manifest : type_manifest option ;
           mutable ty_loc : location ;
           mutable ty_code : string option;
         }
@@ -410,6 +464,7 @@ module Module :
       | Element_class of Class.t_class
       | Element_class_type of Class.t_class_type
       | Element_value of Value.t_value
+      | Element_type_extension of Extension.t_type_extension
       | Element_exception of Exception.t_exception
       | Element_type of Type.t_type
       | Element_module_comment of text
@@ -518,6 +573,9 @@ module Module :
     (** Access to the included modules of a module. *)
     val module_included_modules : ?trans:bool-> t_module -> included_module list
 
+    (** Access to the type extensions of a module. *)
+    val module_type_extensions : ?trans:bool-> t_module -> Extension.t_type_extension list
+
     (** Access to the exceptions of a module. *)
     val module_exceptions : ?trans:bool-> t_module -> Exception.t_exception list
 
@@ -630,6 +688,10 @@ val string_of_type_list : ?par: bool -> string -> Types.type_expr list -> string
    for the given type. *)
 val string_of_type_param_list : Type.t_type -> string
 
+(** This function returns a string to represent the list of type parameters
+   for the given type extension. *)
+val string_of_type_extension_param_list : Extension.t_type_extension -> string
+
 (** This function returns a string to represent the given list of
    type parameters of a class or class type,
    with a given separator. *)
@@ -659,6 +721,9 @@ val string_of_info : info -> string
 (** @return a string to describe the given type. *)
 val string_of_type : Type.t_type -> string
 
+(** @return a string to describe the given type extension. *)
+val string_of_type_extension : Extension.t_type_extension -> string
+
 (** @return a string to describe the given exception. *)
 val string_of_exception : Exception.t_exception -> string
 
@@ -789,6 +854,7 @@ module Search :
         | Res_class_type of Class.t_class_type
         | Res_value of Value.t_value
         | Res_type of Type.t_type
+        | Res_extension of Extension.t_extension_constructor
         | Res_exception of Exception.t_exception
         | Res_attribute of Value.t_attribute
         | Res_method of Value.t_method
@@ -805,6 +871,9 @@ module Search :
       (** A function to search all the values in a list of modules. *)
       val values : Module.t_module list -> Value.t_value list
 
+      (** A function to search all the extensions in a list of modules. *)
+      val extensions : Module.t_module list -> Extension.t_extension_constructor list
+
       (** A function to search all the exceptions in a list of modules. *)
       val exceptions : Module.t_module list -> Exception.t_exception list
 
@@ -844,11 +913,27 @@ module Scan :
         method scan_type_const : Type.t_type -> Type.variant_constructor -> unit
         method scan_type_recfield : Type.t_type -> Type.record_field -> unit
         method scan_type : Type.t_type -> unit
+        method scan_extension_constructor : Extension.t_extension_constructor -> unit
         method scan_exception : Exception.t_exception -> unit
         method scan_attribute : Value.t_attribute -> unit
         method scan_method : Value.t_method -> unit
         method scan_included_module : Module.included_module -> unit
 
+      (** Scan of a type extension *)
+
+        (** Overide this method to perform controls on the extension's type,
+            private and info. This method is called before scanning the
+            extension's constructors.
+            @return true if the extension's constructors must be scanned.*)
+        method scan_type_extension_pre : Extension.t_type_extension -> bool
+
+       (** This method scans the constructors of the given type extension. *)
+        method scan_type_extension_constructors : Extension.t_type_extension -> unit
+
+        (** Scan of a type extension. Should not be overridden. It calls [scan_type_extension_pre]
+            and if [scan_type_extension_pre] returns [true], then it calls scan_type_extension_constructors.*)
+        method scan_type_extension : Extension.t_type_extension -> unit
+
       (** Scan of a class. *)
 
         (** Scan of a comment inside a class. *)
diff --git a/ocamldoc/odoc_latex.ml b/ocamldoc/odoc_latex.ml
index 90dba5fa3f..d0ef4310bb 100644
--- a/ocamldoc/odoc_latex.ml
+++ b/ocamldoc/odoc_latex.ml
@@ -18,6 +18,7 @@ open Odoc_info
 open Parameter
 open Value
 open Type
+open Extension
 open Exception
 open Class
 open Module
@@ -37,6 +38,7 @@ let latex_titles = ref [
 let latex_value_prefix = ref Odoc_messages.default_latex_value_prefix
 let latex_type_prefix = ref Odoc_messages.default_latex_type_prefix
 let latex_type_elt_prefix = ref Odoc_messages.default_latex_type_elt_prefix
+let latex_extension_prefix = ref Odoc_messages.default_latex_extension_prefix
 let latex_exception_prefix = ref Odoc_messages.default_latex_exception_prefix
 let latex_module_prefix = ref Odoc_messages.default_latex_module_prefix
 let latex_module_type_prefix = ref Odoc_messages.default_latex_module_type_prefix
@@ -234,6 +236,9 @@ class text =
     (** Make a correct label from a module type name. *)
     method module_type_label ?no_ name = !latex_module_type_prefix^(self#label ?no_ name)
 
+    (** Make a correct label from an extension name. *)
+    method extension_label ?no_ name = !latex_extension_prefix^(self#label ?no_ name)
+
     (** Make a correct label from an exception name. *)
     method exception_label ?no_ name = !latex_exception_prefix^(self#label ?no_ name)
 
@@ -257,8 +262,8 @@ class text =
       List.iter (self#latex_of_text_element fmt) t
 
     (** Print the LaTeX code for the [text_element] in parameter. *)
-    method latex_of_text_element fmt te =
-      match te with
+    method latex_of_text_element fmt txt =
+      match txt with
       | 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
@@ -411,6 +416,7 @@ class text =
             | Odoc_info.RK_class_type -> self#class_type_label
             | Odoc_info.RK_value -> self#value_label
             | Odoc_info.RK_type -> self#type_label
+            | Odoc_info.RK_extension -> self#extension_label
             | Odoc_info.RK_exception -> self#exception_label
             | Odoc_info.RK_attribute -> self#attribute_label
             | Odoc_info.RK_method -> self#method_label
@@ -533,53 +539,181 @@ class latex =
         let priv = t.ty_private = Asttypes.Private in
         (
          match t.ty_manifest with
-           None -> ()
-         | Some typ ->
+         | Some (Other typ) ->
              p fmt2 " = %s%s" (if priv then "private " else "") (self#normal_type mod_name typ)
+         | _ -> ()
         );
         let s_type3 =
           p fmt2
             " %s"
             (
              match t.ty_kind with
-               Type_abstract -> ""
+               Type_abstract ->
+                begin match t.ty_manifest with
+                | Some (Object_type _) ->
+                  "= " ^ (if priv then "private" else "") ^ " <"
+                | _ -> ""
+                end
              | Type_variant _ -> "="^(if priv then " private" else "")
              | Type_record _ -> "= "^(if priv then "private " else "")^"{"
+             | Type_open -> "= .."
             ) ;
           flush2 ()
         in
 
         let defs =
+          let entry_comment = function
+          | None -> []
+          | Some t ->
+              let s =
+                ps fmt2 "\\begin{ocamldoccomment}\n";
+                self#latex_of_info fmt2 (Some t);
+                ps fmt2 "\n\\end{ocamldoccomment}\n";
+                flush2 ()
+              in
+              [ Latex s]
+        in
           match t.ty_kind with
-            Type_abstract -> []
+          | Type_abstract ->
+             begin match t.ty_manifest with
+             | Some (Object_type l) ->
+               let fields =
+                 List.map (fun r ->
+                   let s_field =
+                     p fmt2
+                       "@[<h 6>  %s :@ %s ;"
+                       r.of_name
+                       (self#normal_type mod_name r.of_type);
+                     flush2 ()
+                   in
+                   [ CodePre s_field ] @ (entry_comment r.of_text)
+                 ) l
+               in
+               List.flatten fields @ [ CodePre ">" ]
+
+             | None | Some (Other _) -> []
+             end
           | Type_variant l ->
-              (List.flatten
-               (List.map
-                  (fun constr ->
-                    let s_cons =
-                      p fmt2 "@[<h 6>  | %s" constr.vc_name;
-                      (
-                       match constr.vc_args, constr.vc_ret with
-                         [], None -> ()
-                       | l, None ->
-                           p fmt2 " %s@ %s"
-                             "of"
-                             (self#normal_type_list ~par: false mod_name " * " l)
-                       | [], Some r ->
-                           p fmt2 " %s@ %s"
-                             ":"
-                             (self#normal_type mod_name r)
-                       | l, Some r ->
-                           p fmt2 " %s@ %s@ %s@ %s"
-                             ":"
-                             (self#normal_type_list ~par: false mod_name " * " l)
-                             "->"
-                             (self#normal_type mod_name r)
-                      );
-                      flush2 ()
+             let constructors =
+               List.map (fun constr ->
+                 let s_cons =
+                   p fmt2 "@[<h 6>  | %s" constr.vc_name ;
+                   begin match constr.vc_args, constr.vc_ret with
+                   | [], None -> ()
+                   | l, None ->
+                     p fmt2 " of@ %s"
+                       (self#normal_type_list ~par: false mod_name " * " l)
+                   | [], Some r ->
+                     p fmt2 " :@ %s"
+                       (self#normal_type mod_name r)
+                   | l, Some r ->
+                     p fmt2 " :@ %s@ %s@ %s"
+                       (self#normal_type_list ~par: false mod_name " * " l)
+                       "->"
+                       (self#normal_type mod_name r)
+                   end ;
+                   flush2 ()
+                 in
+                 [ CodePre s_cons ] @ (entry_comment constr.vc_text)
+               ) l
+             in
+             List.flatten constructors
+          | Type_record l ->
+             let fields =
+               List.map (fun r ->
+                 let s_field =
+                   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);
+                   flush2 ()
+                 in
+                 [ CodePre s_field ] @ (entry_comment r.rf_text)
+               ) l
+             in
+             List.flatten fields @ [ CodePre "}" ]
+          | Type_open ->
+             (* FIXME ? *)
+             []
+        in
+        let defs2 = (CodePre s_type3) :: defs in
+        let rec iter = function
+            [] -> []
+          | [e] -> [e]
+          | (CodePre s1) :: (CodePre s2) :: q ->
+              iter ((CodePre (s1^"\n"^s2)) :: q)
+          | e :: q ->
+              e :: (iter q)
+        in
+        (iter defs2) @
+        [Latex ("\\index{"^(self#label s_name)^"@\\verb`"^(self#label ~no_:false s_name)^"`}\n")] @
+        (self#text_of_info t.ty_info)
+      in
+      self#latex_of_text fmt
+        ((Latex (self#make_label (self#type_label t.ty_name))) :: text)
+
+    (** Print LaTeX code for a type extension. *)
+    method latex_of_type_extension mod_name fmt te =
+      let text =
+        let (fmt2, flush2) = new_fmt () in
+        Odoc_info.reset_type_names () ;
+        Format.fprintf fmt2 "@[<h 2>type ";
+        (
+          match te.te_type_parameters with
+              [] -> ()
+            | [p] ->
+                ps fmt2 (self#normal_type mod_name p);
+                ps fmt2 " "
+            | l ->
+                ps fmt2 "(";
+                print_concat fmt2 ", " (fun p -> ps fmt2 (self#normal_type mod_name p)) l;
+                ps fmt2 ") "
+        );
+        ps fmt2 (self#relative_idents mod_name te.te_type_name);
+        p fmt2 " +=%s" (if te.te_private = Asttypes.Private then " private" else "") ;
+        let s_type3 = flush2 () in
+        let defs =
+          (List.flatten
+             (List.map
+                (fun x ->
+                   let father = Name.father x.xt_name in
+                   let s_cons =
+                     p fmt2 "@[<h 6>  | %s" (Name.simple x.xt_name);
+                     (
+                       match x.xt_args, x.xt_ret with
+                           [], None -> ()
+                         | l, None ->
+                             p fmt2 " %s@ %s"
+                               "of"
+                               (self#normal_type_list ~par: false father " * " l)
+                         | [], Some r ->
+                             p fmt2 " %s@ %s"
+                               ":"
+                               (self#normal_type father r)
+                         | l, Some r ->
+                             p fmt2 " %s@ %s@ %s@ %s"
+                               ":"
+                               (self#normal_type_list ~par: false father " * " l)
+                               "->"
+                               (self#normal_type father r)
+                     );
+                     (
+                       match x.xt_alias with
+                           None -> ()
+                         | Some xa ->
+                             p fmt2 " = %s"
+                               (
+                                 match xa.xa_xt with
+                                     None -> xa.xa_name
+                                   | Some x -> x.xt_name
+                               )
+                     );
+                     flush2 ()
                     in
-                    [ CodePre s_cons ] @
-                    (match constr.vc_text with
+                    [ Latex (self#make_label (self#extension_label x.xt_name));
+                      CodePre s_cons ] @
+                    (match x.xt_text with
                       None -> []
                     | Some t ->
                         let s =
@@ -591,38 +725,9 @@ class latex =
                         [ Latex s]
                     )
                   )
-                  l
+                  te.te_constructors
                )
               )
-          | Type_record l ->
-              (List.flatten
-                 (List.map
-                    (fun r ->
-                      let s_field =
-                        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);
-                        flush2 ()
-                      in
-                      [ CodePre s_field ] @
-                      (match r.rf_text with
-                        None -> []
-                      | Some t ->
-                          let s =
-                            ps fmt2 "\\begin{ocamldoccomment}\n";
-                            self#latex_of_info fmt2 (Some t);
-                            ps fmt2 "\n\\end{ocamldoccomment}\n";
-                            flush2 ()
-                        in
-                        [ Latex s]
-                      )
-                    )
-                    l
-                 )
-              ) @
-              [ CodePre "}" ]
         in
         let defs2 = (CodePre s_type3) :: defs in
         let rec iter = function
@@ -634,11 +739,9 @@ class latex =
               e :: (iter q)
         in
         (iter defs2) @
-        [Latex ("\\index{"^(self#label s_name)^"@\\verb`"^(self#label ~no_:false s_name)^"`}\n")] @
-        (self#text_of_info t.ty_info)
+        (self#text_of_info te.te_info)
       in
-      self#latex_of_text fmt
-        ((Latex (self#make_label (self#type_label t.ty_name))) :: text)
+      self#latex_of_text fmt text
 
     (** Print LaTeX code for an exception. *)
     method latex_of_exception fmt e =
@@ -1034,6 +1137,7 @@ class latex =
       | 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_type_extension te -> self#latex_of_type_extension module_name fmt te
       | 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
diff --git a/ocamldoc/odoc_man.ml b/ocamldoc/odoc_man.ml
index 8a252d6311..def2377882 100644
--- a/ocamldoc/odoc_man.ml
+++ b/ocamldoc/odoc_man.ml
@@ -15,6 +15,7 @@ open Odoc_info
 open Parameter
 open Value
 open Type
+open Extension
 open Exception
 open Class
 open Module
@@ -281,8 +282,8 @@ class man =
       Str.global_replace (Str.regexp "[ ]*\n[ ]*") " " s
 
     (** Print the groff string for a text element. *)
-    method man_of_text_element b te =
-      match te with
+    method man_of_text_element b txt =
+      match txt with
       | Odoc_info.Raw s -> bs b (self#escape s)
       | Odoc_info.Code s ->
           bs b "\n.B ";
@@ -421,6 +422,74 @@ class man =
       self#man_of_info b v.val_info;
       bs b "\n.sp\n"
 
+    (** Print groff string code for a type extension. *)
+    method man_of_type_extension b m_name te =
+      Odoc_info.reset_type_names () ;
+      bs b ".I type ";
+      (
+        match te.te_type_parameters with
+            [] -> ()
+          | l ->
+              let s = Odoc_str.string_of_type_extension_param_list te 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);
+                bs b "\n";
+                bs b ".I "
+      );
+      bs b (self#relative_idents m_name te.te_type_name);
+      bs b " \n";
+      bs b "+=";
+      if te.te_private = Asttypes.Private then bs b " private";
+      bs b "\n ";
+      List.iter
+        (fun x ->
+           let father = Name.father x.xt_name in
+           bs b ("| "^(Name.simple x.xt_name));
+           (
+             match x.xt_args, x.xt_ret with
+               | [], None -> bs b "\n"
+               | l, None ->
+                   bs b "\n.B of ";
+                   self#man_of_type_expr_list ~par: false b father " * " l;
+               | [], Some r ->
+                   bs b "\n.B : ";
+                   self#man_of_type_expr b father r;
+               | l, Some r ->
+                   bs b "\n.B : ";
+                   self#man_of_type_expr_list ~par: false b father " * " l;
+                   bs b ".B -> ";
+                   self#man_of_type_expr b father r;
+           );
+           (
+             match x.xt_alias with
+                 None -> ()
+               | Some xa ->
+                   bs b ".B = ";
+                   bs b
+                     (
+                       match xa.xa_xt with
+                           None -> xa.xa_name
+                         | Some x -> x.xt_name
+                     );
+                   bs b "\n"
+           );
+           (
+             match x.xt_text with
+                 None ->
+                   bs b " "
+               | Some t ->
+                   bs b ".I \"  \"\n";
+                   bs b "(* ";
+                   self#man_of_info b (Some t);
+                   bs b " *)\n "
+           )
+        )
+        te.te_constructors;
+      bs b "\n.sp\n";
+      self#man_of_info b te.te_info;
+      bs b "\n.sp\n"
+
     (** Print groff string code for an exception. *)
     method man_of_exception b e =
       Odoc_info.reset_type_names () ;
@@ -428,13 +497,23 @@ class man =
       bs b (Name.simple e.ex_name);
       bs b " \n";
       (
-       match e.ex_args with
-         [] -> ()
-       | _ ->
+        match e.ex_args, e.ex_ret with
+        | [], None -> ()
+        | l, None ->
            bs b ".B of ";
            self#man_of_type_expr_list
              ~par: false
              b (Name.father e.ex_name) " * " e.ex_args
+        | [], Some r ->
+            bs b ".B : ";
+            self#man_of_type_expr b (Name.father e.ex_name) r
+        | l, Some r ->
+            bs b ".B : ";
+            self#man_of_type_expr_list
+                   ~par: false
+                   b (Name.father e.ex_name) " * " l;
+            bs b ".B -> ";
+            self#man_of_type_expr b (Name.father e.ex_name) r
       );
       (
        match e.ex_alias with
@@ -456,6 +535,13 @@ class man =
     method man_of_type b t =
       Odoc_info.reset_type_names () ;
       let father = Name.father t.ty_name in
+      let field_comment = function
+        | None -> ()
+        | Some t ->
+          bs b "  (* ";
+          self#man_of_info b (Some t);
+          bs b " *) "
+      in
       bs b ".I type ";
       self#man_of_type_expr_param_list b father t;
       (
@@ -469,7 +555,18 @@ class man =
       (
        match t.ty_manifest with
          None -> ()
-       | Some typ ->
+       | Some (Object_type l) ->
+          bs b "= ";
+          if priv then bs b "private ";
+          bs b "<";
+          List.iter (fun r ->
+            bs b (r.of_name^" : ");
+            self#man_of_type_expr b father r.of_type;
+            bs b ";";
+            field_comment r.of_text ;
+          ) l;
+          bs b "\n >\n"
+       | Some (Other typ) ->
            bs b "= ";
            if priv then bs b "private ";
            self#man_of_type_expr b father typ
@@ -478,80 +575,68 @@ class man =
        match t.ty_kind with
         Type_abstract -> ()
       | Type_variant l ->
-          bs b "=";
-          if priv then bs b " private";
-          bs b "\n ";
-          List.iter
-            (fun constr ->
-              bs b ("| "^constr.vc_name);
-              (
-               match constr.vc_args, constr.vc_text,constr.vc_ret with
-               | [], None, None -> bs b "\n "
-               | [], (Some t), None ->
-                   bs b "  (*\n";
-                   self#man_of_info b (Some t);
-                   bs b "*)\n "
-               | l, None, None ->
-                   bs b "\n.B of ";
-                   self#man_of_type_expr_list ~par: false b father " * " l;
-                   bs b " "
-               | l, (Some t), None ->
-                   bs b "\n.B of ";
-                   self#man_of_type_expr_list ~par: false b father " * " l;
-                   bs b ".I \"  \"\n";
-                   bs b "(*\n";
-                   self#man_of_info b (Some t);
-                   bs b "*)\n"
-               | [], None, Some r ->
-                   bs b "\n.B : ";
-                   self#man_of_type_expr b father r;
-                   bs b " "
-               | [], (Some t), Some r ->
-                   bs b "\n.B : ";
-                   self#man_of_type_expr b father r;
-                   bs b ".I \"  \"\n";
-                   bs b "(*\n";
-                   self#man_of_info b (Some t);
-                   bs b "*)\n "
-               | l, None, Some r ->
-                   bs b "\n.B : ";
-                   self#man_of_type_expr_list ~par: false b father " * " l;
-                   bs b ".B -> ";
-                   self#man_of_type_expr b father r;
-                   bs b " "
-               | l, (Some t), Some r ->
-                   bs b "\n.B of ";
-                   self#man_of_type_expr_list ~par: false b father " * " l;
-                   bs b ".B -> ";
-                   self#man_of_type_expr b father r;
-                   bs b ".I \"  \"\n";
-                   bs b "(*\n";
-                   self#man_of_info b (Some t);
-                   bs b "*)\n "
-              )
-            )
-            l
+         bs b "=";
+         if priv then bs b " private";
+         bs b "\n ";
+         List.iter (fun constr ->
+           bs b ("| "^constr.vc_name);
+           let print_text t =
+             bs b "  (* ";
+             self#man_of_info b (Some t);
+             bs b " *)\n "
+           in
+           match constr.vc_args, constr.vc_text,constr.vc_ret with
+           | [], None, None -> bs b "\n "
+           | [], (Some t), None ->
+             print_text t
+           | l, None, None ->
+             bs b "\n.B of ";
+             self#man_of_type_expr_list ~par: false b father " * " l;
+             bs b " "
+           | l, (Some t), None ->
+             bs b "\n.B of ";
+             self#man_of_type_expr_list ~par: false b father " * " l;
+             bs b ".I \"  \"\n";
+             print_text t
+           | [], None, Some r ->
+             bs b "\n.B : ";
+             self#man_of_type_expr b father r;
+             bs b " "
+           | [], (Some t), Some r ->
+             bs b "\n.B : ";
+             self#man_of_type_expr b father r;
+             bs b ".I \"  \"\n";
+             print_text t
+           | l, None, Some r ->
+             bs b "\n.B : ";
+             self#man_of_type_expr_list ~par: false b father " * " l;
+             bs b ".B -> ";
+             self#man_of_type_expr b father r;
+             bs b " "
+           | l, (Some t), Some r ->
+             bs b "\n.B of ";
+             self#man_of_type_expr_list ~par: false b father " * " l;
+             bs b ".B -> ";
+             self#man_of_type_expr b father r;
+             bs b ".I \"  \"\n";
+             print_text t
+         ) l
+
       | Type_record l ->
           bs b "= ";
           if priv then bs b "private ";
           bs b "{";
-          List.iter
-            (fun r ->
-              bs b (if r.rf_mutable then "\n\n.B mutable \n" else "\n ");
-              bs b (r.rf_name^" : ");
-              self#man_of_type_expr b father r.rf_type;
-              bs b ";";
-              (
-               match r.rf_text with
-                 None -> ()
-               | Some t ->
-                   bs b "  (*\n";
-                   self#man_of_info b (Some t);
-                   bs b "*) "
-              );
-            )
-            l;
+           List.iter (fun r ->
+             bs b (if r.rf_mutable then "\n\n.B mutable \n" else "\n ");
+             bs b (r.rf_name^" : ");
+             self#man_of_type_expr b father r.rf_type;
+             bs b ";";
+             field_comment r.rf_text ;
+           ) l;
           bs b "\n }\n"
+      | Type_open ->
+          bs b "= ..";
+          bs b "\n"
       );
       bs b "\n.sp\n";
       self#man_of_info b t.ty_info;
@@ -724,6 +809,33 @@ class man =
       self#man_of_text b [Code ("=== "^(Odoc_misc.string_of_text text)^" ===")];
       bs b "\n.PP\n"
 
+    method man_of_recfield b modname f =
+      bs b ".I ";
+      if f.rf_mutable then bs b (Odoc_messages.mutab^" ");
+      bs b (f.rf_name^" : ");
+      self#man_of_type_expr b modname f.rf_type;
+      bs b "\n.sp\n";
+      self#man_of_info b f.rf_text;
+      bs b "\n.sp\n"
+
+    method man_of_const b modname c =
+      bs b ".I ";
+      bs b (c.vc_name^" ");
+      (match c.vc_args with
+         [] -> ()
+       | h::q ->
+         bs b "of ";
+         self#man_of_type_expr b modname h;
+         List.iter
+           (fun ty ->
+              bs b " * ";
+              self#man_of_type_expr b modname ty)
+            q
+      );
+      bs b "\n.sp\n";
+      self#man_of_info b c.vc_text;
+      bs b "\n.sp\n"
+
     (** Print groff string for an included module. *)
     method man_of_included_module b m_name im =
       bs b ".I include ";
@@ -858,6 +970,42 @@ class man =
           incr Odoc_info.errors ;
           prerr_endline s
 
+    method man_of_module_type_body b mt =
+      self#man_of_info b mt.mt_info;
+      bs b "\n.sp\n";
+
+      (* parameters for functors *)
+      self#man_of_module_parameter_list b "" (Module.module_type_parameters mt);
+      (* a large blank *)
+      bs b "\n.sp\n.sp\n";
+
+      (* module elements *)
+      List.iter
+        (fun ele ->
+          match ele with
+            Element_module m ->
+              self#man_of_module b m
+          | Element_module_type mt ->
+              self#man_of_modtype b mt
+          | Element_included_module im ->
+              self#man_of_included_module b mt.mt_name im
+          | Element_class c ->
+              self#man_of_class b c
+          | Element_class_type ct ->
+              self#man_of_class_type b ct
+          | Element_value v ->
+              self#man_of_value b v
+          | Element_type_extension te ->
+              self#man_of_type_extension b mt.mt_name te
+          | Element_exception e ->
+              self#man_of_exception b e
+          | Element_type t ->
+              self#man_of_type b t
+          | Element_module_comment text ->
+              self#man_of_module_comment b text
+        )
+        (Module.module_type_elements mt);
+
     (** Generate the man file for the given module type.
        @raise Failure if an error occurs.*)
     method generate_for_module_type mt =
@@ -895,38 +1043,7 @@ class man =
              self#man_of_module_type b (Name.father mt.mt_name) t
         );
         bs b "\n.sp\n";
-        self#man_of_info b mt.mt_info;
-        bs b "\n.sp\n";
-
-        (* parameters for functors *)
-        self#man_of_module_parameter_list b "" (Module.module_type_parameters mt);
-        (* a large blank *)
-        bs b "\n.sp\n.sp\n";
-
-        (* module elements *)
-        List.iter
-          (fun ele ->
-            match ele with
-              Element_module m ->
-                self#man_of_module b m
-            | Element_module_type mt ->
-                self#man_of_modtype b mt
-            | Element_included_module im ->
-                self#man_of_included_module b mt.mt_name im
-            | Element_class c ->
-                self#man_of_class b c
-            | Element_class_type ct ->
-                self#man_of_class_type b ct
-            | Element_value v ->
-                self#man_of_value b v
-            | Element_exception e ->
-                self#man_of_exception b e
-            | Element_type t ->
-                self#man_of_type b t
-            | Element_module_comment text ->
-                self#man_of_module_comment b text
-          )
-          (Module.module_type_elements mt);
+        self#man_of_module_type_body b mt;
 
         Buffer.output_buffer chanout b;
         close_out chanout
@@ -936,6 +1053,42 @@ class man =
           incr Odoc_info.errors ;
           prerr_endline s
 
+    method man_of_module_body b m =
+      self#man_of_info b m.m_info;
+      bs b "\n.sp\n";
+
+      (* parameters for functors *)
+      self#man_of_module_parameter_list b "" (Module.module_parameters m);
+      (* a large blank *)
+      bs b "\n.sp\n.sp\n";
+
+      (* module elements *)
+      List.iter
+        (fun ele ->
+          match ele with
+            Element_module m ->
+              self#man_of_module b m
+          | Element_module_type mt ->
+              self#man_of_modtype b mt
+          | Element_included_module im ->
+              self#man_of_included_module b m.m_name im
+          | Element_class c ->
+              self#man_of_class b c
+          | Element_class_type ct ->
+              self#man_of_class_type b ct
+          | Element_value v ->
+              self#man_of_value b v
+          | Element_type_extension te ->
+              self#man_of_type_extension b m.m_name te
+          | Element_exception e ->
+              self#man_of_exception b e
+          | Element_type t ->
+              self#man_of_type b t
+          | Element_module_comment text ->
+              self#man_of_module_comment b text
+        )
+        (Module.module_elements m);
+
     (** Generate the man file for the given module.
        @raise Failure if an error occurs.*)
     method generate_for_module m =
@@ -969,39 +1122,7 @@ class man =
         bs b " : ";
         self#man_of_module_type b (Name.father m.m_name) m.m_type;
         bs b "\n.sp\n";
-        self#man_of_info b m.m_info;
-        bs b "\n.sp\n";
-
-        (* parameters for functors *)
-        self#man_of_module_parameter_list b "" (Module.module_parameters m);
-        (* a large blank *)
-        bs b "\n.sp\n.sp\n";
-
-        (* module elements *)
-        List.iter
-          (fun ele ->
-            match ele with
-              Element_module m ->
-                self#man_of_module b m
-            | Element_module_type mt ->
-                self#man_of_modtype b mt
-            | Element_included_module im ->
-                self#man_of_included_module b m.m_name im
-            | Element_class c ->
-                self#man_of_class b c
-            | Element_class_type ct ->
-                self#man_of_class_type b ct
-            | Element_value v ->
-                self#man_of_value b v
-            | Element_exception e ->
-                self#man_of_exception b e
-            | Element_type t ->
-                self#man_of_type b t
-            | Element_module_comment text ->
-                self#man_of_module_comment b text
-          )
-          (Module.module_elements m);
-
+        self#man_of_module_body b m;
         Buffer.output_buffer chanout b;
         close_out chanout
 
@@ -1010,7 +1131,7 @@ class man =
           raise (Failure s)
 
     (** Create the groups of elements to generate pages for. *)
-    method create_groups module_list =
+    method create_groups mini module_list =
       let name res_ele =
         match res_ele with
           Res_module m -> m.m_name
@@ -1019,6 +1140,7 @@ class man =
         | Res_class_type ct -> ct.clt_name
         | Res_value v -> Name.simple v.val_name
         | Res_type t -> Name.simple t.ty_name
+        | Res_extension x -> Name.simple x.xt_name
         | Res_exception e -> Name.simple e.ex_name
         | Res_attribute a -> Name.simple a.att_value.val_name
         | Res_method m -> Name.simple m.met_value.val_name
@@ -1028,7 +1150,13 @@ class man =
       in
       let all_items_pre = Odoc_info.Search.search_by_name module_list (Str.regexp ".*")  in
       let all_items = List.filter
-          (fun r -> match r with Res_section _ -> false | _ -> true)
+          (fun r ->
+             match r with
+               Res_section _ -> false
+             | Res_module _ | Res_module_type _
+             | Res_class _ | Res_class_type _ -> true
+             | _ -> not mini
+          )
           all_items_pre
       in
       let sorted_items = List.sort (fun e1 -> fun e2 -> compare (name e1) (name e2)) all_items in
@@ -1062,6 +1190,7 @@ class man =
           | Res_class_type ct -> ct.clt_name
           | Res_value v -> v.val_name
           | Res_type t -> t.ty_name
+          | Res_extension x -> x.xt_name
           | Res_exception e -> e.ex_name
           | Res_attribute a -> a.att_value.val_name
           | Res_method m -> m.met_value.val_name
@@ -1091,6 +1220,9 @@ class man =
           | Res_type t ->
               bs b ("\n.SH "^Odoc_messages.modul^" "^(Name.father t.ty_name)^"\n");
               self#man_of_type b t
+          | Res_extension x ->
+              bs b ("\n.SH "^Odoc_messages.modul^" "^(Name.father x.xt_name)^"\n");
+              self#man_of_type_extension b (Name.father x.xt_name) x.xt_type_extension
           | Res_exception e ->
               bs b ("\n.SH "^Odoc_messages.modul^" "^(Name.father e.ex_name)^"\n");
               self#man_of_exception b e
@@ -1106,7 +1238,45 @@ class man =
           | Res_class_type ct ->
               bs b ("\n.SH "^Odoc_messages.modul^" "^(Name.father ct.clt_name)^"\n");
               self#man_of_class_type b ct
-          | _ ->
+          | Res_recfield (ty,f) ->
+               bs b ("\n.SH Type "^(ty.ty_name)^"\n");
+              self#man_of_recfield b (Name.father ty.ty_name) f
+          | Res_const (ty,c) ->
+               bs b ("\n.SH Type "^(ty.ty_name)^"\n");
+              self#man_of_const b (Name.father ty.ty_name) c
+          | Res_module m ->
+              if Name.father m.m_name <> "" then
+                begin
+                  bs b ("\n.SH "^Odoc_messages.modul^" "^(Name.father m.m_name)^"\n");
+                  bs b (Odoc_messages.modul^"\n");
+                  bs b (".BI \""^(Name.simple m.m_name)^"\"\n");
+                  bs b " : ";
+                  self#man_of_module_type b (Name.father m.m_name) m.m_type;
+                end
+              else
+                begin
+                  bs b ("\n.SH "^Odoc_messages.modul^" "^m.m_name^"\n");
+                  bs b " : ";
+                  self#man_of_module_type b (Name.father m.m_name) m.m_type;
+                end;
+              bs b "\n.sp\n";
+              self#man_of_module_body b m
+
+          | Res_module_type mt ->
+              bs b ("\n.SH "^Odoc_messages.modul^" "^(Name.father mt.mt_name)^"\n");
+              bs b (Odoc_messages.module_type^"\n");
+              bs b (".BI \""^(Name.simple mt.mt_name)^"\"\n");
+              bs b " = ";
+              (
+               match mt.mt_type with
+                None -> ()
+              | Some t ->
+                 self#man_of_module_type b (Name.father mt.mt_name) t
+              );
+              bs b "\n.sp\n";
+              self#man_of_module_type_body b mt
+
+          | Res_section _ ->
               (* normalement on ne peut pas avoir de module ici. *)
               ()
         in
@@ -1121,7 +1291,7 @@ class man =
     (** Generate all the man pages from a module list. *)
     method generate module_list =
       let sorted_module_list = Sort.list (fun m1 -> fun m2 -> m1.m_name < m2.m_name) module_list in
-      let groups = self#create_groups sorted_module_list in
+      let groups = self#create_groups !man_mini sorted_module_list in
       let f group =
         match group with
           [] ->
@@ -1130,11 +1300,7 @@ class man =
         | [Res_module_type mt] -> self#generate_for_module_type mt
         | [Res_class cl] -> self#generate_for_class cl
         | [Res_class_type ct] -> self#generate_for_class_type ct
-        | l ->
-            if !man_mini then
-              ()
-            else
-              self#generate_for_group l
+        | l -> self#generate_for_group l
       in
       List.iter f groups
   end
diff --git a/ocamldoc/odoc_merge.ml b/ocamldoc/odoc_merge.ml
index eda6491ec9..443cc3d8a5 100644
--- a/ocamldoc/odoc_merge.ml
+++ b/ocamldoc/odoc_merge.ml
@@ -18,6 +18,7 @@ module Name = Odoc_name
 open Odoc_parameter
 open Odoc_value
 open Odoc_type
+open Odoc_extension
 open Odoc_exception
 open Odoc_class
 open Odoc_module
@@ -287,12 +288,41 @@ let merge_types merge_options mli ml =
       in
       List.iter f l1
 
+  | Type_open, Type_open ->
+      ()
+
   | _ ->
       if !Odoc_global.inverse_merge_ml_mli then
         ()
       else
         raise (Failure (Odoc_messages.different_types mli.ty_name))
 
+(** merge of two t_type_extension, one for a .mli, another for the .ml.
+   The .mli type is completed with the information in the .ml type.
+   Information for the extension constructors is merged separately
+   by [merge_extension_constructor]. *)
+let merge_type_extension merge_options mli ml =
+  mli.te_info <- merge_info_opt merge_options mli.te_info ml.te_info;
+  mli.te_loc <- { mli.te_loc with loc_impl = ml.te_loc.loc_impl } ;
+  mli.te_code <- (match mli.te_code with None -> ml.te_code | _ -> mli.te_code)
+
+(** merge of two t_extension_constructor, one for a .mli, another for the .ml.
+   The .mli type is completed with the information in the .ml type. *)
+let merge_extension_constructor merge_options mli ml =
+  let new_desc =
+    match mli.xt_text, ml.xt_text with
+      None, None -> None
+    | Some d, None
+    | None, Some d -> Some d
+    | Some d1, Some d2 ->
+      if List.mem Merge_description merge_options then
+        Some (merge_info merge_options d1 d2)
+      else
+        Some d1
+  in
+    mli.xt_text <- new_desc
+
+
 (** Merge of two param_info, one from a .mli, one from a .ml.
    The text fields are not handled but will be recreated from the
    i_params field of the info structure.
@@ -498,6 +528,33 @@ let merge_class_types merge_options mli ml =
 let rec merge_module_types merge_options mli ml =
   mli.mt_info <- merge_info_opt merge_options mli.mt_info ml.mt_info;
   mli.mt_loc <- { mli.mt_loc with loc_impl = ml.mt_loc.loc_impl } ;
+  (* merge type extensions *)
+  List.iter
+    (fun te ->
+       let rec f exts elems =
+         match exts, elems with
+             [], _
+           | _, [] -> ()
+           | _, (Element_type_extension te2 :: rest) ->
+               let merge_ext xt =
+                 try
+                   let xt2 =
+                     List.find (fun xt2 -> xt.xt_name = xt2.xt_name)
+                       te2.te_constructors
+                   in
+                     merge_extension_constructor merge_options xt xt2;
+                     true
+                 with Not_found -> false
+               in
+               let merged, unmerged = List.partition merge_ext exts in
+                 if merged <> [] then merge_type_extension merge_options te te2;
+                 f unmerged rest
+           | _, (_ :: rest) -> f exts rest
+       in
+         (* we look for the extensions in reverse order *)
+         f te.te_constructors (List.rev (Odoc_module.module_type_elements ml))
+    )
+    (Odoc_module.module_type_type_extensions mli);
   (* merge exceptions *)
   List.iter
     (fun ex ->
@@ -746,6 +803,33 @@ and merge_modules merge_options mli ml =
   mli.m_code <- code;
   mli.m_code_intf <- code_intf;
 
+  (* merge type extensions *)
+  List.iter
+    (fun te ->
+       let rec f exts elems =
+         match exts, elems with
+             [], _
+           | _, [] -> ()
+           | _, (Element_type_extension te2 :: rest) ->
+               let merge_ext xt =
+                 try
+                   let xt2 =
+                     List.find (fun xt2 -> xt.xt_name = xt2.xt_name)
+                       te2.te_constructors
+                   in
+                     merge_extension_constructor merge_options xt xt2;
+                     true
+                 with Not_found -> false
+               in
+               let merged, unmerged = List.partition merge_ext exts in
+                 if merged <> [] then merge_type_extension merge_options te te2;
+                 f unmerged rest
+           | _, (_ :: rest) -> f exts rest
+       in
+         (* we look for the extensions in reverse order *)
+         f te.te_constructors (List.rev (Odoc_module.module_elements ml))
+    )
+    (Odoc_module.module_type_extensions mli);
   (* merge exceptions *)
   List.iter
     (fun ex ->
diff --git a/ocamldoc/odoc_messages.ml b/ocamldoc/odoc_messages.ml
index 2d6327bba7..4c409a3a17 100644
--- a/ocamldoc/odoc_messages.ml
+++ b/ocamldoc/odoc_messages.ml
@@ -132,6 +132,11 @@ let latex_type_elt_prefix =
   "<string>\n\t\tUse <string> as prefix for the LaTeX labels of type elements.\n"^
   "\t\t(default is \""^default_latex_type_elt_prefix^"\")"
 
+let default_latex_extension_prefix = "extension:"
+let latex_extension_prefix =
+  "<string>\n\t\tUse <string> as prefix for the LaTeX labels of extensions.\n"^
+  "\t\t(default is \""^default_latex_extension_prefix^"\")"
+
 let default_latex_exception_prefix = "exception:"
 let latex_exception_prefix =
   "<string>\n\t\tUse <string> as prefix for the LaTeX labels of exceptions.\n"^
@@ -258,6 +263,7 @@ let unknown_extension f = "Unknown extension for file "^f^"."
 let two_implementations name = "There are two implementations of module "^name^"."
 let two_interfaces name = "There are two interfaces of module "^name^"."
 let too_many_module_objects name = "There are too many interfaces/implementation of module "^name^"."
+let extension_not_found_in_implementation ext m = "Extension "^ext^" was not found in implementation of module "^m^"."
 let exception_not_found_in_implementation exc m = "Exception "^exc^" was not found in implementation of module "^m^"."
 let type_not_found_in_implementation exc m = "Type "^exc^" was not found in implementation of module "^m^"."
 let module_not_found_in_implementation m m2 = "Module "^m^" was not found in implementation of module "^m2^"."
@@ -271,11 +277,13 @@ let method_type_not_found cl met = "The type of the method "^met^" could not be
 let module_not_found m m2 = "The module "^m2^" could not be found in the signature of module "^m^"."
 let module_type_not_found m mt = "The module type "^mt^" could not be found in the signature of module "^m^"."
 let value_not_found m v = "The value "^v^" could not be found in the signature of module "^m^"."
+let extension_not_found m e = "The extension "^e^" could not be found in the signature of module "^m^"."
 let exception_not_found m e = "The exception "^e^" could not be found in the signature of module "^m^"."
 let type_not_found m t = "The type "^t^" could not be found in the signature of module "^m^"."
 let class_not_found m c = "The class "^c^" could not be found in the signature of module "^m^"."
 let class_type_not_found m c = "The class type "^c^" could not be found in the signature of module "^m^"."
 let type_not_found_in_typedtree t = "Type "^t^" was not found in typed tree."
+let extension_not_found_in_typedtree x = "Extension "^x^" was not found in typed tree."
 let exception_not_found_in_typedtree e = "Exception "^e^" was not found in typed tree."
 let module_type_not_found_in_typedtree mt = "Module type "^mt^" was not found in typed tree."
 let module_not_found_in_typedtree m = "Module "^m^" was not found in typed tree."
@@ -293,6 +301,7 @@ let cross_module_or_module_type_not_found n = "Module or module type "^n^" not f
 let cross_class_not_found n = "Class "^n^" not found"
 let cross_class_type_not_found n = "class type "^n^" not found"
 let cross_class_or_class_type_not_found n = "Class or class type "^n^" not found"
+let cross_extension_not_found n = "Extension "^n^" not found"
 let cross_exception_not_found n = "Exception "^n^" not found"
 let cross_element_not_found n = "Element "^n^" not found"
 let cross_method_not_found n = "Method "^n^" not found"
@@ -329,6 +338,7 @@ let modules = "Modules"
 let functors = "Functors"
 let values = "Simple values"
 let types = "Types"
+let extensions = "Extensions"
 let exceptions = "Exceptions"
 let record = "Record"
 let variant = "Variant"
@@ -363,6 +373,7 @@ let documentation = "Documentation"
 let index_of = "Index of"
 let top = "Top"
 let index_of_values = index_of^" values"
+let index_of_extensions = index_of^" extensions"
 let index_of_exceptions = index_of^" exceptions"
 let index_of_types = index_of^" types"
 let index_of_attributes = index_of^" class attributes"
diff --git a/ocamldoc/odoc_misc.ml b/ocamldoc/odoc_misc.ml
index c762ade2a4..e938dbe679 100644
--- a/ocamldoc/odoc_misc.ml
+++ b/ocamldoc/odoc_misc.ml
@@ -23,7 +23,7 @@ let no_blanks s =
 let input_file_as_string nom =
   let chanin = open_in_bin nom in
   let len = 1024 in
-  let s = String.create len in
+  let s = Bytes.create len in
   let buf = Buffer.create len in
   let rec iter () =
     try
@@ -32,7 +32,7 @@ let input_file_as_string nom =
         ()
       else
         (
-         Buffer.add_substring buf s 0 n;
+         Buffer.add_subbytes buf s 0 n;
          iter ()
         )
     with
@@ -313,8 +313,8 @@ let get_titles_in_text t =
     | Odoc_types.Index_list -> ()
     | Odoc_types.Custom (_, t) -> iter_text t
     | Odoc_types.Target _ -> ()
-  and iter_text te =
-    List.iter iter_ele te
+  and iter_text txt =
+    List.iter iter_ele txt
   in
   iter_text t;
   List.rev !l
diff --git a/ocamldoc/odoc_module.ml b/ocamldoc/odoc_module.ml
index b1bedfa77f..9ed2b17717 100644
--- a/ocamldoc/odoc_module.ml
+++ b/ocamldoc/odoc_module.ml
@@ -24,6 +24,7 @@ type module_element =
   | Element_class of Odoc_class.t_class
   | Element_class_type of Odoc_class.t_class_type
   | Element_value of Odoc_value.t_value
+  | Element_type_extension of Odoc_extension.t_type_extension
   | Element_exception of Odoc_exception.t_exception
   | Element_type of Odoc_type.t_type
   | Element_module_comment of Odoc_types.text
@@ -127,6 +128,17 @@ let types l =
     []
     l
 
+(** Returns the list of type extensions from a list of module_element. *)
+let type_extensions l =
+  List.fold_left
+    (fun acc -> fun ele ->
+      match ele with
+        Element_type_extension x -> acc @ [x]
+      | _ -> acc
+    )
+    []
+    l
+
 (** Returns the list of exceptions from a list of module_element. *)
 let exceptions l =
   List.fold_left
@@ -301,7 +313,11 @@ let module_simple_values ?(trans=true) m =
   @param trans indicates if, for aliased modules, we must perform a transitive search.*)
 let module_types ?(trans=true) m = types (module_elements ~trans m)
 
-(** Returns the list of excptions of a module.
+(** Returns the list of type extensions of a module.
+  @param trans indicates if, for aliased modules, we must perform a transitive search.*)
+let module_type_extensions ?(trans=true) m = type_extensions (module_elements ~trans m)
+
+(** Returns the list of exceptions of a module.
   @param trans indicates if, for aliased modules, we must perform a transitive search.*)
 let module_exceptions ?(trans=true) m = exceptions (module_elements ~trans m)
 
@@ -463,7 +479,11 @@ let module_type_values ?(trans=true) m = values (module_type_elements ~trans m)
   @param trans indicates if, for aliased modules, we must perform a transitive search.*)
 let module_type_types ?(trans=true) m = types (module_type_elements ~trans m)
 
-(** Returns the list of excptions of a module.
+(** Returns the list of type extensions of a module.
+  @param trans indicates if, for aliased modules, we must perform a transitive search.*)
+let module_type_type_extensions ?(trans=true) m = type_extensions (module_type_elements ~trans m)
+
+(** Returns the list of exceptions of a module.
   @param trans indicates if, for aliased modules, we must perform a transitive search.*)
 let module_type_exceptions ?(trans=true) m = exceptions (module_type_elements ~trans m)
 
diff --git a/ocamldoc/odoc_scan.ml b/ocamldoc/odoc_scan.ml
index e507c48b7e..e6c19f29d4 100644
--- a/ocamldoc/odoc_scan.ml
+++ b/ocamldoc/odoc_scan.ml
@@ -38,12 +38,32 @@ class scanner =
           Odoc_type.Type_abstract -> ()
         | Odoc_type.Type_variant l -> List.iter (self#scan_type_const t) l
         | Odoc_type.Type_record l -> List.iter (self#scan_type_recfield t) l
+        | Odoc_type.Type_open -> ()
 
+    method scan_extension_constructor (e : Odoc_extension.t_extension_constructor) = ()
     method scan_exception (e : Odoc_exception.t_exception) = ()
     method scan_attribute (a : Odoc_value.t_attribute) = ()
     method scan_method (m : Odoc_value.t_method) = ()
     method scan_included_module (im : Odoc_module.included_module) = ()
 
+  (** Scan of a type extension *)
+
+    (** Overide this method to perform controls on the extension's type,
+        private and info. This method is called before scanning the
+        extensions's constructors.
+        @return true if the extension's constructors must be scanned.*)
+    method scan_type_extension_pre (x: Odoc_extension.t_type_extension) = true
+
+    (** This method scans the constructors of the given type extension. *)
+    method scan_type_extension_constructors (x: Odoc_extension.t_type_extension) =
+      List.iter self#scan_extension_constructor (Odoc_extension.extension_constructors x)
+
+    (** Scan of a type extension. Should not be overridden. It calls [scan_type_extension_pre]
+      and if [scan_type_extension_pre] returns [true], then it calls scan_type_extension_constructors.*)
+    method scan_type_extension (x: Odoc_extension.t_type_extension) =
+      if self#scan_type_extension_pre x then self#scan_type_extension_constructors x
+
+
   (** Scan of a class. *)
 
     (** Scan of a comment inside a class. *)
@@ -117,6 +137,7 @@ class scanner =
           | Odoc_module.Element_class c -> self#scan_class c
           | Odoc_module.Element_class_type ct -> self#scan_class_type ct
           | Odoc_module.Element_value v -> self#scan_value v
+          | Odoc_module.Element_type_extension x -> self#scan_type_extension x
           | Odoc_module.Element_exception e -> self#scan_exception e
           | Odoc_module.Element_type t -> self#scan_type t
           | Odoc_module.Element_module_comment t -> self#scan_module_comment t
@@ -148,6 +169,7 @@ class scanner =
           | Odoc_module.Element_class c -> self#scan_class c
           | Odoc_module.Element_class_type ct -> self#scan_class_type ct
           | Odoc_module.Element_value v -> self#scan_value v
+          | Odoc_module.Element_type_extension x -> self#scan_type_extension x
           | Odoc_module.Element_exception e -> self#scan_exception e
           | Odoc_module.Element_type t -> self#scan_type t
           | Odoc_module.Element_module_comment t -> self#scan_module_comment t
diff --git a/ocamldoc/odoc_search.ml b/ocamldoc/odoc_search.ml
index 4e76d9fe49..763b71602d 100644
--- a/ocamldoc/odoc_search.ml
+++ b/ocamldoc/odoc_search.ml
@@ -16,6 +16,7 @@ module Name = Odoc_name
 open Odoc_parameter
 open Odoc_value
 open Odoc_type
+open Odoc_extension
 open Odoc_exception
 open Odoc_class
 open Odoc_module
@@ -27,6 +28,7 @@ type result_element =
   | Res_class_type of t_class_type
   | Res_value of t_value
   | Res_type of t_type
+  | Res_extension of t_extension_constructor
   | Res_exception of t_exception
   | Res_attribute of t_attribute
   | Res_method of t_method
@@ -47,6 +49,7 @@ module type Predicates =
     val p_recfield : t_type -> record_field -> t -> bool
     val p_const : t_type -> variant_constructor -> t -> bool
     val p_type : t_type -> t -> (bool * bool)
+    val p_extension : t_extension_constructor -> t -> bool
     val p_exception : t_exception -> t -> bool
     val p_attribute : t_attribute -> t -> bool
     val p_method : t_method -> t -> bool
@@ -113,9 +116,19 @@ module Search =
                 List.flatten (List.map (fun rf -> search_recfield t rf v) l)
             | Type_variant l ->
                 List.flatten (List.map (fun rf -> search_const t rf v) l)
+            | Type_open -> []
       in
       if ok then (Res_type t) :: l else l
 
+    let search_extension_constructor xt v =
+      if P.p_extension xt v then [Res_extension xt] else []
+
+    let search_type_extension te v =
+      List.fold_left
+        (fun acc -> fun xt -> acc @ (search_extension_constructor xt v))
+        []
+        (Odoc_extension.extension_constructors te)
+
     let search_exception e v = if P.p_exception e v then [Res_exception e] else []
 
     let search_attribute a v = if P.p_attribute a v then [Res_attribute a] else []
@@ -202,6 +215,12 @@ module Search =
               []
               (Odoc_module.module_type_types mt)
           in
+          let res_ext =
+            List.fold_left
+              (fun acc -> fun te -> acc @ (search_type_extension te v))
+              []
+              (Odoc_module.module_type_type_extensions mt)
+          in
           let res_exc =
             List.fold_left
               (fun acc -> fun e -> acc @ (search_exception e v))
@@ -233,7 +252,7 @@ module Search =
               []
               (Odoc_module.module_type_comments mt)
           in
-          let l = res_val @ res_typ @ res_exc @ res_mod @
+          let l = res_val @ res_typ @ res_ext @ res_exc @ res_mod @
             res_modtyp @ res_cl @ res_cltyp @ res_sec
           in
           l
@@ -261,6 +280,12 @@ module Search =
               []
               (Odoc_module.module_types m)
           in
+          let res_ext =
+            List.fold_left
+              (fun acc -> fun te -> acc @ (search_type_extension te v))
+              []
+              (Odoc_module.module_type_extensions m)
+          in
           let res_exc =
             List.fold_left
               (fun acc -> fun e -> acc @ (search_exception e v))
@@ -292,7 +317,7 @@ module Search =
               []
               (Odoc_module.module_comments m)
           in
-          let l = res_val @ res_typ @ res_exc @ res_mod @
+          let l = res_val @ res_typ @ res_ext @ res_exc @ res_mod @
             res_modtyp @ res_cl @ res_cltyp @ res_sec
           in
           l
@@ -334,6 +359,7 @@ module P_name =
       let name = Printf.sprintf "%s.%s" t.ty_name f.vc_name in
       name =~ r
     let p_type t r = (true, t.ty_name =~ r)
+    let p_extension x r = x.xt_name =~ r
     let p_exception e r = e.ex_name =~ r
     let p_attribute a r = a.att_value.val_name =~ r
     let p_method m r = m.met_value.val_name =~ r
@@ -353,6 +379,7 @@ module P_values =
     let p_recfield _ _ _ = false
     let p_const _ _ _ = false
     let p_type _ _ = (false, false)
+    let p_extension _ _ = false
     let p_exception _ _ = false
     let p_attribute _ _ = false
     let p_method _ _ = false
@@ -369,6 +396,34 @@ let values l =
   in
   iter [] l_ele
 
+module P_extensions =
+  struct
+    type t = unit
+    let p_module _ _ = (true, false)
+    let p_module_type _ _ = (true, false)
+    let p_class _ _ = (false, false)
+    let p_class_type _ _ = (false, false)
+    let p_value _ _ = false
+    let p_recfield _ _ _ = false
+    let p_const _ _ _ = false
+    let p_type _ _ = (false, false)
+    let p_extension _ _ = true
+    let p_exception _ _ = false
+    let p_attribute _ _ = false
+    let p_method _ _ = false
+    let p_section _ _ = false
+  end
+module Search_extensions = Search ( P_extensions )
+let extensions l =
+  let l_ele = Search_extensions.search l () in
+  let p x1 x2 = x1.xt_name = x2.xt_name in
+  let rec iter acc = function
+      (Res_extension x) :: q -> if List.exists (p x) acc then iter acc q else iter (x :: acc) q
+    | _ :: q -> iter acc q
+    | [] -> acc
+  in
+  iter [] l_ele
+
 module P_exceptions =
   struct
     type t = unit
@@ -380,6 +435,7 @@ module P_exceptions =
     let p_recfield _ _ _ = false
     let p_const _ _ _ = false
     let p_type _ _ = (false, false)
+    let p_extension _ _ = false
     let p_exception _ _ = true
     let p_attribute _ _ = false
     let p_method _ _ = false
@@ -407,6 +463,7 @@ module P_types =
     let p_recfield _ _ _ = false
     let p_const _ _ _ = false
     let p_type _ _ = (false, true)
+    let p_extension _ _ = false
     let p_exception _ _ = false
     let p_attribute _ _ = false
     let p_method _ _ = false
@@ -434,6 +491,7 @@ module P_attributes =
     let p_recfield _ _ _ = false
     let p_const _ _ _ = false
     let p_type _ _ = (false, false)
+    let p_extension _ _ = false
     let p_exception _ _ = false
     let p_attribute _ _ = true
     let p_method _ _ = false
@@ -461,6 +519,7 @@ module P_methods =
     let p_recfield _ _ _ = false
     let p_const _ _ _ = false
     let p_type _ _ = (false, false)
+    let p_extension _ _ = false
     let p_exception _ _ = false
     let p_attribute _ _ = false
     let p_method _ _ = true
@@ -488,6 +547,7 @@ module P_classes =
     let p_recfield _ _ _ = false
     let p_const _ _ _ = false
     let p_type _ _ = (false, false)
+    let p_extension _ _ = false
     let p_exception _ _ = false
     let p_attribute _ _ = false
     let p_method _ _ = false
@@ -515,6 +575,7 @@ module P_class_types =
     let p_recfield _ _ _ = false
     let p_const _ _ _ = false
     let p_type _ _ = (false, false)
+    let p_extension _ _ = false
     let p_exception _ _ = false
     let p_attribute _ _ = false
     let p_method _ _ = false
@@ -542,6 +603,7 @@ module P_modules =
     let p_recfield _ _ _ = false
     let p_const _ _ _ = false
     let p_type _ _ = (false, false)
+    let p_extension _ _ = false
     let p_exception _ _ = false
     let p_attribute _ _ = false
     let p_method _ _ = false
@@ -569,6 +631,7 @@ module P_module_types =
     let p_recfield _ _ _ = false
     let p_const _ _ _ = false
     let p_type _ _ = (false, false)
+    let p_extension _ _ = false
     let p_exception _ _ = false
     let p_attribute _ _ = false
     let p_method _ _ = false
@@ -639,6 +702,15 @@ let module_type_exists mods regexp =
     )
     l
 
+let extension_exists mods regexp =
+  let l = Search_by_name.search mods regexp in
+  List.exists
+    (function
+        Res_extension _ -> true
+      | _ -> false
+    )
+    l
+
 let exception_exists mods regexp =
   let l = Search_by_name.search mods regexp in
   List.exists
diff --git a/ocamldoc/odoc_search.mli b/ocamldoc/odoc_search.mli
index bd101aa558..e0d9f2c27a 100644
--- a/ocamldoc/odoc_search.mli
+++ b/ocamldoc/odoc_search.mli
@@ -20,6 +20,7 @@ type result_element =
   | Res_class_type of Odoc_class.t_class_type
   | Res_value of Odoc_value.t_value
   | Res_type of Odoc_type.t_type
+  | Res_extension of Odoc_extension.t_extension_constructor
   | Res_exception of Odoc_exception.t_exception
   | Res_attribute of Odoc_value.t_attribute
   | Res_method of Odoc_value.t_method
@@ -46,6 +47,8 @@ module type Predicates =
     val p_recfield : Odoc_type.t_type -> Odoc_type.record_field -> t -> bool
     val p_const : Odoc_type.t_type -> Odoc_type.variant_constructor -> t -> bool
     val p_type : Odoc_type.t_type -> t -> (bool * bool)
+    val p_extension :
+      Odoc_extension.t_extension_constructor -> t -> bool
     val p_exception : Odoc_exception.t_exception -> t -> bool
     val p_attribute : Odoc_value.t_attribute -> t -> bool
     val p_method : Odoc_value.t_method -> t -> bool
@@ -73,6 +76,14 @@ module Search :
       (** search in a type *)
       val search_type : Odoc_type.t_type -> P.t -> result_element list
 
+      (** search in an extension constructor *)
+      val search_extension_constructor :
+          Odoc_extension.t_extension_constructor -> P.t -> result_element list
+
+      (** search in a type extension *)
+      val search_type_extension :
+          Odoc_extension.t_type_extension -> P.t -> result_element list
+
       (** search in an exception *)
       val search_exception :
           Odoc_exception.t_exception -> P.t -> result_element list
@@ -116,6 +127,8 @@ module P_name :
     val p_recfield : Odoc_type.t_type -> Odoc_type.record_field -> Str.regexp -> bool
     val p_const : Odoc_type.t_type -> Odoc_type.variant_constructor -> Str.regexp -> bool
     val p_type : Odoc_type.t_type -> Str.regexp -> (bool * bool)
+    val p_extension :
+      Odoc_extension.t_extension_constructor -> Str.regexp -> bool
     val p_exception : Odoc_exception.t_exception -> Str.regexp -> bool
     val p_attribute : Odoc_value.t_attribute -> Str.regexp -> bool
     val p_method : Odoc_value.t_method -> Str.regexp -> bool
@@ -129,6 +142,10 @@ module Search_by_name :
     val search_recfield : Odoc_type.t_type -> Odoc_type.record_field -> P_name.t -> result_element list
     val search_const : Odoc_type.t_type -> Odoc_type.variant_constructor -> P_name.t -> result_element list
     val search_type : Odoc_type.t_type -> P_name.t -> result_element list
+    val search_extension_constructor :
+      Odoc_extension.t_extension_constructor -> P_name.t -> result_element list
+    val search_type_extension :
+      Odoc_extension.t_type_extension -> P_name.t -> result_element list
     val search_exception :
       Odoc_exception.t_exception -> P_name.t -> result_element list
     val search_attribute :
@@ -148,6 +165,10 @@ module Search_by_name :
 (** A function to search all the values in a list of modules. *)
 val values : Odoc_module.t_module list -> Odoc_value.t_value list
 
+(** A function to search all the extension constructors in a list of modules. *)
+val extensions :
+  Odoc_module.t_module list -> Odoc_extension.t_extension_constructor list
+
 (** A function to search all the exceptions in a list of modules. *)
 val exceptions : Odoc_module.t_module list -> Odoc_exception.t_exception list
 
@@ -196,6 +217,10 @@ val class_exists : Odoc_module.t_module list -> Str.regexp -> bool
    in the given module list.*)
 val class_type_exists : Odoc_module.t_module list -> Str.regexp -> bool
 
+(** Return [true] if an extension with the given complete name (regexp) exists
+   in the given module list.*)
+val extension_exists : Odoc_module.t_module list -> Str.regexp -> bool
+
 (** Return [true] if a exception with the given complete name (regexp) exists
    in the given module list.*)
 val exception_exists : Odoc_module.t_module list -> Str.regexp -> bool
diff --git a/ocamldoc/odoc_sig.ml b/ocamldoc/odoc_sig.ml
index 13b2503157..48fe8cd7f4 100644
--- a/ocamldoc/odoc_sig.ml
+++ b/ocamldoc/odoc_sig.ml
@@ -24,6 +24,7 @@ module Name = Odoc_name
 open Odoc_parameter
 open Odoc_value
 open Odoc_type
+open Odoc_extension
 open Odoc_exception
 open Odoc_class
 open Odoc_module
@@ -38,8 +39,7 @@ module Signature_search =
       | T of string
       | C of string
       | CT of string
-      | E of string
-      | ER of string
+      | X of string
       | P of string
 
     type tab = (ele, Types.signature_item) Hashtbl.t
@@ -48,8 +48,8 @@ module Signature_search =
       match signat with
         Types.Sig_value (ident, _) ->
           Hashtbl.add table (V (Name.from_ident ident)) signat
-      | Types.Sig_exception (ident, _) ->
-          Hashtbl.add table (E (Name.from_ident ident)) signat
+      | Types.Sig_typext (ident, _, _) ->
+          Hashtbl.add table (X (Name.from_ident ident)) signat
       | Types.Sig_type (ident, _, _) ->
           Hashtbl.add table (T (Name.from_ident ident)) signat
       | Types.Sig_class (ident, _, _) ->
@@ -71,10 +71,9 @@ module Signature_search =
       | (Types.Sig_value (_, val_desc)) ->  val_desc.Types.val_type
       | _ -> assert false
 
-    let search_exception table name =
-      match Hashtbl.find table (E name) with
-      | (Types.Sig_exception (_, type_expr_list)) ->
-          type_expr_list
+    let search_extension table name =
+      match Hashtbl.find table (X name) with
+      | (Types.Sig_typext (_, ext, _)) -> ext
       | _ -> assert false
 
     let search_type table name =
@@ -169,10 +168,44 @@ module Analyser =
 
     let merge_infos = Odoc_merge.merge_info_opt Odoc_types.all_merge_options
 
-    let name_comment_from_type_kind pos_end pos_limit tk =
-      match tk with
-        Parsetree.Ptype_abstract ->
-          (0, [])
+    let name_comment_from_type_decl pos_end pos_limit ty_decl =
+      match ty_decl.Parsetree.ptype_kind with
+      | Parsetree.Ptype_abstract ->
+        let open Parsetree in
+        begin match ty_decl.ptype_manifest with
+        | None -> (0, [])
+        | Some core_ty ->
+          begin match core_ty.ptyp_desc with
+          | Ptyp_object (fields, _) ->
+            let rec f = function
+              | [] -> []
+              | ("",_,_) :: _ ->
+                (* Fields with no name have been eliminated previously. *)
+                assert false
+
+              | (name, _atts, ct) :: [] ->
+                let pos = ct.Parsetree.ptyp_loc.Location.loc_end.Lexing.pos_cnum in
+                let s = get_string_of_file pos pos_end in
+                let (_,comment_opt) =  My_ir.just_after_special !file_name s in
+                [name, comment_opt]
+              | (name, _atts, ct) :: ((name2, _atts2, ct2) as ele2) :: q ->
+                let pos = ct.Parsetree.ptyp_loc.Location.loc_end.Lexing.pos_cnum in
+                let pos2 = ct2.Parsetree.ptyp_loc.Location.loc_start.Lexing.pos_cnum in
+                let s = get_string_of_file pos pos2 in
+                let (_,comment_opt) =  My_ir.just_after_special !file_name s in
+                (name, comment_opt) :: (f (ele2 :: q))
+            in
+            let is_named_field field =
+              match field with
+              | ("",_,_) -> false
+              | _ -> true
+            in
+            (0, f @@ List.filter is_named_field fields)
+
+          | _ -> (0, [])
+          end
+        end
+
       | Parsetree.Ptype_variant cons_core_type_list_list ->
           let rec f acc cons_core_type_list_list =
             let open Parsetree in
@@ -213,6 +246,25 @@ module Analyser =
                 (name.txt, comment_opt) :: (f (ele2 :: q))
           in
           (0, f name_mutable_type_list)
+      | Parsetree.Ptype_open ->
+          (0, [])
+
+
+    let manifest_structure env name_comment_list type_expr =
+      match type_expr.desc with
+      | Tobject (fields, _) ->
+        let f (field_name, _, type_expr) =
+          let comment_opt =
+            try List.assoc field_name name_comment_list
+            with Not_found -> None
+          in {
+            of_name = field_name ;
+            of_type = Odoc_env.subst_type env type_expr ;
+            of_text = comment_opt ;
+          }
+        in
+        Object_type (List.map f @@ fst @@ Ctype.flatten_fields fields)
+      | _ -> Other (Odoc_env.subst_type env type_expr)
 
     let get_type_kind env name_comment_list type_kind =
       match type_kind with
@@ -222,7 +274,7 @@ module Analyser =
           let f {Types.cd_id=constructor_name;cd_args=type_expr_list;cd_res=ret_type} =
             let constructor_name = Ident.name constructor_name in
             let comment_opt =
-              try List.assoc constructor_name name_comment_list 
+              try List.assoc constructor_name name_comment_list
               with Not_found -> None
             in
             {
@@ -250,6 +302,10 @@ module Analyser =
           in
           Odoc_type.Type_record (List.map f l)
 
+      | Types.Type_open ->
+          Odoc_type.Type_open
+
+
     let erased_names_of_constraints constraints acc =
       List.fold_right (fun constraint_ acc ->
         match constraint_ with
@@ -267,6 +323,7 @@ module Analyser =
         | Parsetree.Psig_attribute _
         | Parsetree.Psig_extension _
         | Parsetree.Psig_value _
+        | Parsetree.Psig_typext _
         | Parsetree.Psig_exception _
         | Parsetree.Psig_open _
         | Parsetree.Psig_include _
@@ -297,7 +354,8 @@ module Analyser =
             match ele2.Parsetree.pctf_desc with
               Parsetree.Pctf_val (_, _, _, _)
             | Parsetree.Pctf_method (_, _, _, _)
-            | Parsetree.Pctf_constraint (_, _) -> loc.Location.loc_start.Lexing.pos_cnum
+            | Parsetree.Pctf_constraint (_, _)
+            | Parsetree.Pctf_attribute _ -> loc.Location.loc_start.Lexing.pos_cnum
             | Parsetree.Pctf_inherit class_type ->
                 class_type.Parsetree.pcty_loc.Location.loc_start.Lexing.pos_cnum
             | Parsetree.Pctf_extension _ -> assert false
@@ -456,6 +514,11 @@ module Analyser =
             in
             let (inher_l, eles) = f (pos_end + maybe_more) q in
             (inh :: inher_l , eles_comments @ eles)
+        | Parsetree.Pctf_attribute _ ->
+            let (comment_opt, eles_comments) = get_comments_in_class last_pos loc.Location.loc_start.Lexing.pos_cnum in
+            let (inher_l, eles) = f loc.Location.loc_end.Lexing.pos_cnum q in
+            (inher_l, eles_comments @ eles)
+
         | Parsetree.Pctf_extension _ -> assert false
       in
       f last_pos class_type_field_list
@@ -550,10 +613,86 @@ module Analyser =
             let new_env = Odoc_env.add_value env v.val_name in
             (maybe_more, new_env, [ Element_value v ])
 
-        | Parsetree.Psig_exception exception_decl ->
-            let name = exception_decl.Parsetree.pcd_name in
-            let types_excep_decl =
-              try Signature_search.search_exception table name.txt
+        | Parsetree.Psig_typext tyext ->
+          let new_env, types_ext_list, last_ext =
+            List.fold_left
+              (fun (env_acc, exts_acc, _) -> fun {Parsetree.pext_name = { txt = name }} ->
+                let complete_name = Name.concat current_module_name name in
+                let env_acc = Odoc_env.add_extension env_acc complete_name in
+                let types_ext =
+                  try Signature_search.search_extension table name
+                  with Not_found ->
+                    raise (Failure (Odoc_messages.extension_not_found current_module_name name))
+                in
+                  env_acc, ((name, types_ext) :: exts_acc), Some types_ext
+              )
+              (env, [], None)
+              tyext.Parsetree.ptyext_constructors
+          in
+          let ty_path, ty_params, priv =
+            match last_ext with
+              None -> assert false
+            | Some ext -> ext.ext_type_path, ext.ext_type_params, ext.ext_private
+          in
+          let new_te =
+            {
+              te_info = comment_opt;
+              te_type_name =
+                Odoc_env.full_type_name new_env (Name.from_path ty_path);
+              te_type_parameters =
+                List.map (Odoc_env.subst_type new_env) ty_params;
+              te_private = priv;
+              te_constructors = [];
+              te_loc = { loc_impl = None ; loc_inter = Some sig_item_loc} ;
+              te_code =
+                (
+                  if !Odoc_global.keep_code then
+                    Some (get_string_of_file pos_start_ele pos_end_ele)
+                  else
+                    None
+                ) ;
+            }
+          in
+          let rec analyse_extension_constructors maybe_more exts_acc types_ext_list =
+            match types_ext_list with
+              [] -> (maybe_more, List.rev exts_acc)
+            | (name, types_ext) :: q ->
+              let ext_loc_end =  types_ext.Types.ext_loc.Location.loc_end.Lexing.pos_cnum in
+              let new_x =
+                {
+                  xt_name = Name.concat current_module_name name ;
+                  xt_args = List.map (Odoc_env.subst_type new_env) types_ext.ext_args ;
+                  xt_ret = may_map (Odoc_env.subst_type new_env) types_ext.ext_ret_type ;
+                  xt_type_extension = new_te;
+                  xt_alias = None ;
+                  xt_loc = { loc_impl = None ; loc_inter = Some types_ext.Types.ext_loc} ;
+                  xt_text = None;
+                }
+              in
+              let pos_limit2 =
+                match q with
+                  [] -> pos_limit
+                | (_, next) :: _ -> next.Types.ext_loc.Location.loc_start.Lexing.pos_cnum
+              in
+              let s = get_string_of_file ext_loc_end pos_limit2 in
+              let (maybe_more, comment_opt) =  My_ir.just_after_special !file_name s in
+                new_x.xt_text <- comment_opt;
+                analyse_extension_constructors maybe_more (new_x :: exts_acc) q
+          in
+          let (maybe_more, exts) = analyse_extension_constructors 0 [] types_ext_list in
+            new_te.te_constructors <- exts;
+            let (maybe_more2, info_after_opt) =
+              My_ir.just_after_special
+                !file_name
+                (get_string_of_file (pos_end_ele + maybe_more) pos_limit)
+            in
+              new_te.te_info <- merge_infos new_te.te_info info_after_opt ;
+              (maybe_more + maybe_more2, new_env, [ Element_type_extension new_te ])
+
+        | Parsetree.Psig_exception ext ->
+            let name = ext.Parsetree.pext_name in
+            let types_ext =
+              try Signature_search.search_extension table name.txt
               with Not_found ->
                 raise (Failure (Odoc_messages.exception_not_found current_module_name name.txt))
             in
@@ -561,7 +700,8 @@ module Analyser =
               {
                 ex_name = Name.concat current_module_name name.txt ;
                 ex_info = comment_opt ;
-                ex_args = List.map (Odoc_env.subst_type env) types_excep_decl.exn_args ;
+                ex_args = List.map (Odoc_env.subst_type env) types_ext.ext_args ;
+                ex_ret = may_map (Odoc_env.subst_type env) types_ext.ext_ret_type ;
                 ex_alias = None ;
                 ex_loc = { loc_impl = None ; loc_inter = Some sig_item_loc } ;
                 ex_code =
@@ -579,7 +719,7 @@ module Analyser =
                 (get_string_of_file pos_end_ele pos_limit)
             in
             e.ex_info <- merge_infos e.ex_info info_after_opt ;
-            let new_env = Odoc_env.add_exception env e.ex_name in
+            let new_env = Odoc_env.add_extension env e.ex_name in
             (maybe_more, new_env, [ Element_exception e ])
 
         | Parsetree.Psig_type name_type_decl_list ->
@@ -613,10 +753,10 @@ module Analyser =
                     | td :: _ -> td.Parsetree.ptype_loc.Location.loc_start.Lexing.pos_cnum
                   in
                   let (maybe_more, name_comment_list) =
-                    name_comment_from_type_kind
+                    name_comment_from_type_decl
                       type_decl.Parsetree.ptype_loc.Location.loc_end.Lexing.pos_cnum
                       pos_limit2
-                      type_decl.Parsetree.ptype_kind
+                      type_decl
                   in
                   print_DEBUG ("Type "^name.txt^" : "^(match assoc_com with None -> "sans commentaire" | Some c -> Odoc_misc.string_of_info c));
                   let f_DEBUG (name, c_opt) = print_DEBUG ("constructor/field "^name^": "^(match c_opt with None -> "sans commentaire" | Some c -> Odoc_misc.string_of_info c)) in
@@ -645,9 +785,11 @@ module Analyser =
                       ty_kind = type_kind;
                       ty_private = sig_type_decl.Types.type_private;
                       ty_manifest =
-                      (match sig_type_decl.Types.type_manifest with
-                        None -> None
-                      | Some t -> Some (Odoc_env.subst_type new_env t));
+                        begin match sig_type_decl.Types.type_manifest with
+                        | None   -> None
+                        | Some t ->
+                          Some (manifest_structure env name_comment_list t)
+                        end ;
                       ty_loc = { loc_impl = None ;  loc_inter = Some sig_item_loc } ;
                       ty_code =
                         (
diff --git a/ocamldoc/odoc_sig.mli b/ocamldoc/odoc_sig.mli
index f0c3c4a132..5dc4b4c8c0 100644
--- a/ocamldoc/odoc_sig.mli
+++ b/ocamldoc/odoc_sig.mli
@@ -27,10 +27,10 @@ module Signature_search :
          @raise Not_found if error.*)
       val search_value : tab -> string -> Types.type_expr
 
-      (** This function returns the type expression list for the exception whose name is given,
+      (** This function returns the Types.extension_constructor for the extension whose name is given,
          in the given table.
          @raise Not_found if error.*)
-      val search_exception : tab -> string -> Types.exception_declaration
+      val search_extension : tab -> string -> Types.extension_constructor
 
       (** This function returns the Types.type_declaration  for the type whose name is given,
          in the given table.
@@ -42,7 +42,7 @@ module Signature_search :
          @raise Not_found if error.*)
       val search_class : tab -> string -> Types.class_declaration
 
-      (** This function returns the Types.cltype_declaration  for the class type whose name is given,
+      (** This function returns the Types.class_type_declaration  for the class type whose name is given,
          in the given table.
          @raise Not_found if error.*)
       val search_class_type : tab -> string -> Types.class_type_declaration
@@ -139,8 +139,14 @@ module Analyser :
          [pos_end] is last char of the complete type definition.
          [pos_limit] is the position of the last char we could use to look for a comment,
          i.e. usually the beginning on the next element.*)
-      val name_comment_from_type_kind :
-          int -> int -> Parsetree.type_kind -> int * (string * Odoc_types.info option) list
+      val name_comment_from_type_decl :
+          int -> int -> Parsetree.type_declaration -> int * (string * Odoc_types.info option) list
+
+      (** This function converts a [Types.type_expr] into a [Odoc_type.type_kind],
+         by associating the comment found in the parstree of each object field, if any. *)
+      val manifest_structure :
+          Odoc_env.env -> (string * Odoc_types.info option) list ->
+            Types.type_expr -> Odoc_type.type_manifest
 
       (** This function converts a [Types.type_kind] into a [Odoc_type.type_kind],
          by associating the comment found in the parsetree of each constructor/field, if any.*)
diff --git a/ocamldoc/odoc_str.ml b/ocamldoc/odoc_str.ml
index 3c45c50705..7d99ff1079 100644
--- a/ocamldoc/odoc_str.ml
+++ b/ocamldoc/odoc_str.ml
@@ -15,7 +15,8 @@
 module Name = Odoc_name
 
 let string_of_variance t (co,cn) =
-  if t.Odoc_type.ty_kind = Odoc_type.Type_abstract &&
+  if ( t.Odoc_type.ty_kind = Odoc_type.Type_abstract ||
+      t.Odoc_type.ty_kind = Odoc_type.Type_open ) &&
     t.Odoc_type.ty_manifest = None
   then
     match (co, cn) with
@@ -106,6 +107,23 @@ let string_of_type_param_list t =
     )
     (if par then ")" else "")
 
+let string_of_type_extension_param_list te =
+  let par =
+    match te.Odoc_extension.te_type_parameters with
+      [] | [_] -> false
+    | _ -> true
+  in
+  Printf.sprintf "%s%s%s"
+    (if par then "(" else "")
+    (raw_string_of_type_list ", "
+       (List.map
+          (fun typ -> ("", typ))
+          te.Odoc_extension.te_type_parameters
+       )
+    )
+    (if par then ")" else "")
+
+
 let string_of_class_type_param_list l =
   let par =
     match l with
@@ -155,91 +173,159 @@ let bool_of_private = function
 
 let string_of_type t =
   let module M = Odoc_type in
-  "type "^
-  (String.concat ""
-     (List.map
-        (fun (p, co, cn) ->
-          (string_of_variance t (co, cn))^
-          (Odoc_print.string_of_type_expr p)^" "
+   let module P = Printf in
+   let field_doc_str = function
+     | None -> ""
+     | Some t -> P.sprintf "(* %s *)" (Odoc_misc.string_of_info t)
+   in
+   let priv = bool_of_private t.M.ty_private in
+   let parameters_str =
+     String.concat " " (
+       List.map (fun (p, co, cn) ->
+         (string_of_variance t (co, cn)) ^ (Odoc_print.string_of_type_expr p)
+       ) t.M.ty_parameters
+     )
+   in
+   let manifest_str =
+     match t.M.ty_manifest with
+     | None -> ""
+     | Some (M.Object_type fields) ->
+       P.sprintf "= %s<\n%s\n>\n" (if priv then "private " else "") (
+         String.concat "\n" (
+           List.map (fun field ->
+             P.sprintf "   %s : %s;%s" field.M.of_name
+               (Odoc_print.string_of_type_expr field.M.of_type)
+               (field_doc_str field.M.of_text)
+           ) fields
         )
-        t.M.ty_parameters
      )
-  )^
-  let priv = bool_of_private (t.M.ty_private) in
-  (Name.simple t.M.ty_name)^" "^
-  (match t.M.ty_manifest with
-    None -> ""
-  | Some typ ->
+   | Some (M.Other typ) ->
      "= " ^ (if priv then "private " else "" ) ^
-       (Odoc_print.string_of_type_expr typ)^" "
-  )^
-  (match t.M.ty_kind with
-    M.Type_abstract ->
-      ""
-  | M.Type_variant l ->
-      "="^(if priv then " private" else "")^"\n"^
-      (String.concat ""
-         (List.map
-            (fun cons ->
-              "  | "^cons.M.vc_name^
-              (match cons.M.vc_args,cons.M.vc_ret with
+       (Odoc_print.string_of_type_expr typ) ^ " "
+ in
+ let type_kind_str =
+   match t.M.ty_kind with
+   | M.Type_abstract -> ""
+   | M.Type_variant l ->
+     P.sprintf "=%s\n%s\n" (if priv then " private" else "") (
+       String.concat "\n" (
+         List.map (fun cons ->
+           let comment =
+             match cons.M.vc_text with
+             | None -> ""
+             | Some t -> P.sprintf "(* %s *)" (Odoc_misc.string_of_info t)
+           in
+           let string_of_parameters lst =
+             String.concat " * " (
+               List.map (fun t -> "("^Odoc_print.string_of_type_expr t^")") lst
+             )
+           in
+           P.sprintf "  | %s%s%s" cons.M.vc_name (
+             match cons.M.vc_args, cons.M.vc_ret with
               | [], None -> ""
-              | l, None ->
-                  " of " ^
-                  (String.concat " * "
-                     (List.map
-                        (fun t -> "("^Odoc_print.string_of_type_expr t^")") l))
+              | li, None -> " of " ^ (string_of_parameters li)
               | [], Some r -> " : " ^ Odoc_print.string_of_type_expr r
-              | l, Some r ->
-                  " : " ^
-                  (String.concat " * "
-                     (List.map
-                        (fun t -> "("^Odoc_print.string_of_type_expr t^")") l))
-                  ^ " -> " ^ Odoc_print.string_of_type_expr r
-              )^
-              (match cons.M.vc_text with
-                None ->
-                  ""
-              | Some t ->
-                  "(* "^(Odoc_misc.string_of_info t)^" *)"
-              )^"\n"
-            )
-            l
-         )
+              | li, Some r ->
+                 P.sprintf " : %s -> %s" (string_of_parameters li)
+                   (Odoc_print.string_of_type_expr r)
+             ) comment
+           ) l
+        )
       )
+
+  | M.Type_open ->
+      "= .." (* FIXME MG: when introducing new constuctors next time,
+                thanks to setup a minimal correct output *)
   | M.Type_record l ->
-      "= "^(if priv then "private " else "")^"{\n"^
-      (String.concat ""
-         (List.map
-            (fun record ->
-              "   "^(if record.M.rf_mutable then "mutable " else "")^
-              record.M.rf_name^" : "^
-              (Odoc_print.string_of_type_expr record.M.rf_type)^";"^
-              (match record.M.rf_text with
-                None ->
-                  ""
-              | Some t ->
-                  "(* "^(Odoc_misc.string_of_info t)^" *)"
-              )^"\n"
-            )
-            l
-         )
-      )^
-      "}\n"
-  )^
-  (match t.M.ty_info with
-    None -> ""
-  | Some info -> Odoc_misc.string_of_info info)
+     P.sprintf "= %s{\n%s\n}\n" (if priv then "private " else "") (
+       String.concat "\n" (
+         List.map (fun field ->
+           P.sprintf "   %s%s : %s;%s"
+             (if field.M.rf_mutable then "mutable " else "") field.M.rf_name
+             (Odoc_print.string_of_type_expr field.M.rf_type)
+             (field_doc_str field.M.rf_text)
+         ) l
+       )
+     )
+ in
+ P.sprintf "type %s %s %s%s%s" parameters_str (Name.simple t.M.ty_name)
+   manifest_str type_kind_str
+   (match t.M.ty_info with
+    | None -> ""
+    | Some info -> Odoc_misc.string_of_info info)
+
+let string_of_type_extension te =
+  let module M = Odoc_extension in
+    "type "
+    ^(String.concat ""
+        (List.map
+           (fun p -> (Odoc_print.string_of_type_expr p)^" ")
+           te.M.te_type_parameters
+        ))
+    ^te.M.te_type_name
+    ^" += "
+    ^(if (bool_of_private te.M.te_private) then "private " else "")
+    ^"\n"
+    ^(String.concat ""
+        (List.map
+           (fun x ->
+              "  | "
+              ^(Name.simple x.M.xt_name)
+              ^(match x.M.xt_args, x.M.xt_ret with
+                  | [], None -> ""
+                  | l, None ->
+                      " of " ^
+                        (String.concat " * "
+                           (List.map
+                              (fun t -> "("^Odoc_print.string_of_type_expr t^")") l))
+                  | [], Some r -> " : " ^ Odoc_print.string_of_type_expr r
+                  | l, Some r ->
+                      " : " ^
+                        (String.concat " * "
+                           (List.map
+                              (fun t -> "("^Odoc_print.string_of_type_expr t^")") l))
+                      ^ " -> " ^ Odoc_print.string_of_type_expr r
+               )
+              ^(match x.M.xt_alias with
+                    None -> ""
+                  | Some xa ->
+                      " = "^
+                        (match xa.M.xa_xt with
+                             None -> xa.M.xa_name
+                           | Some x2 -> x2.M.xt_name
+                        )
+               )
+              ^(match x.M.xt_text with
+                    None ->
+                      ""
+                  | Some t ->
+                      "(* "^(Odoc_misc.string_of_info t)^" *)"
+               )^"\n"
+           )
+           te.M.te_constructors))
+    ^(match te.M.te_info with
+          None -> ""
+        | Some i -> Odoc_misc.string_of_info i
+     )
 
 let string_of_exception e =
   let module M = Odoc_exception in
   "exception "^(Name.simple e.M.ex_name)^
-  (match e.M.ex_args with
-    [] -> ""
-  | _ ->" : "^
-      (String.concat " -> "
-         (List.map (fun t -> "("^(Odoc_print.string_of_type_expr t)^")") e.M.ex_args)
-      )
+  (match e.M.ex_args, e.M.ex_ret with
+     [], None -> ""
+   | l,None ->
+       " of "^
+       (String.concat " * "
+         (List.map (fun t -> "("^(Odoc_print.string_of_type_expr t)^")") l))
+   | [],Some r ->
+       " : "^
+       (Odoc_print.string_of_type_expr r)
+   | l,Some r ->
+       " : "^
+       (String.concat " * "
+         (List.map (fun t -> "("^(Odoc_print.string_of_type_expr t)^")") l))^
+       " -> "^
+       (Odoc_print.string_of_type_expr r)
   )^
   (match e.M.ex_alias with
     None -> ""
diff --git a/ocamldoc/odoc_str.mli b/ocamldoc/odoc_str.mli
index 44278bb0fe..402a82d567 100644
--- a/ocamldoc/odoc_str.mli
+++ b/ocamldoc/odoc_str.mli
@@ -25,6 +25,10 @@ val string_of_type_list : ?par: bool -> string -> Types.type_expr list -> string
    for the given type. *)
 val string_of_type_param_list : Odoc_type.t_type -> string
 
+(** This function returns a string to represent the list of type parameters
+   for the given type extension. *)
+val string_of_type_extension_param_list : Odoc_extension.t_type_extension -> string
+
 (** This function returns a string to represent the given list of
    type parameters of a class or class type,
    with a given separator. *)
@@ -37,6 +41,9 @@ val string_of_type : Odoc_type.t_type -> string
    in the same form as the compiler. *)
 val string_of_class_params : Odoc_class.t_class -> string
 
+(** @return a string to describe the given type extension. *)
+val string_of_type_extension : Odoc_extension.t_type_extension -> string
+
 (** @return a string to describe the given exception. *)
 val string_of_exception : Odoc_exception.t_exception -> string
 
diff --git a/ocamldoc/odoc_test.ml b/ocamldoc/odoc_test.ml
index cd7b5fa044..c68e853267 100644
--- a/ocamldoc/odoc_test.ml
+++ b/ocamldoc/odoc_test.ml
@@ -53,10 +53,11 @@ struct
           p fmt "# type %s:\n" t.ty_name;
           if self#must_display_types then
             (
-             p fmt "# manifest (Odoc_info.string_of_type_expr):\n<[%s]>\n"
+             p fmt "# manifest :\n<[%s]>\n"
                (match t.ty_manifest with
                  None -> "None"
-               | Some e -> Odoc_info.string_of_type_expr e
+               | Some (Object_type _fields) -> "< object type >" (* TODO *)
+               | Some (Other e) -> Odoc_info.string_of_type_expr e
                );
             );
 
diff --git a/ocamldoc/odoc_texi.ml b/ocamldoc/odoc_texi.ml
index 95354caac8..10d45c1c80 100644
--- a/ocamldoc/odoc_texi.ml
+++ b/ocamldoc/odoc_texi.ml
@@ -16,6 +16,7 @@ open Odoc_info
 open Parameter
 open Value
 open Type
+open Extension
 open Exception
 open Class
 open Module
@@ -42,24 +43,20 @@ let is = function
 
 let pad_to n s =
   let len = String.length s in
-  if len < n
-  then
-    let s' = String.make n ' ' in
-    String.blit s 0 s' 0 len ; s'
-  else s
+  if len < n then s ^ String.make (n - len) ' ' else s
 
 let indent nb_sp s =
   let c = ref 0 in
   let len = pred (String.length s) in
   for i = 0 to len do if s.[i] = '\n' then incr c done ;
-  let s' = String.make (succ len + (succ !c) * nb_sp ) ' ' in
+  let s' = Bytes.make (succ len + (succ !c) * nb_sp ) ' ' in
   c := nb_sp ;
   for i = 0 to len do
-    s'.[!c] <- s.[i] ;
+    Bytes.set s' !c s.[i] ;
     if s.[i] = '\n' then c := !c + nb_sp ;
     incr c
   done ;
-  s'
+  Bytes.to_string s'
 
 type subparts = [
   | `Module of Odoc_info.Module.t_module
@@ -102,6 +99,7 @@ let module_subparts =
 
 type indices = [
   | `Type
+  | `Extension
   | `Exception
   | `Value
   | `Class_att
@@ -114,6 +112,7 @@ type indices = [
 
 let indices = function
   | `Type        -> "ty"
+  | `Extension   -> "xt"
   | `Exception   -> "ex"
   | `Value       -> "va"
   | `Class_att   -> "ca"
@@ -125,6 +124,7 @@ let indices = function
 
 let indices_names = [
   "Types"           , "ty" ;
+  "Extensions"      , "xt" ;
   "Exceptions"      , "ex" ;
   "Values"          , "va" ;
   "Class attributes", "ca" ;
@@ -440,17 +440,16 @@ class texi =
             | Raw s -> Raw (Str.global_replace re "\n" s)
             | List tel -> List (List.map self#fix_linebreaks tel)
             | Enum tel -> Enum (List.map self#fix_linebreaks tel)
-            | te -> te) t
+            | txt -> txt) t
 
     method private soft_fix_linebreaks =
       let re = Str.regexp "\n[ \t]*" in
       fun ind t ->
-        let rep = String.make (succ ind) ' ' in
-        rep.[0] <- '\n' ;
+        let rep = "\n" ^ String.make ind ' ' in
         List.map
           (function
             | Raw s -> Raw (Str.global_replace re rep s)
-            | te -> te) t
+            | txt -> txt) t
 
     (** {3 [text] values generation}
        Generates [text] values out of description parts.
@@ -650,6 +649,12 @@ class texi =
     (** Return Texinfo code for a type. *)
     method texi_of_type ty =
       Odoc_info.reset_type_names () ;
+      let entry_doc = function
+        | None -> [ Newline ]
+        | Some t ->
+          (Raw (indent 5 "\n(*\n") :: (self#soft_fix_linebreaks 8 (self#text_of_info (Some t))))
+          @ [ Raw " *)" ; Newline ]
+      in
       let t =
         [ self#fixedblock (
           [ Newline ; minus ; Raw "type " ;
@@ -658,10 +663,24 @@ class texi =
           let priv = ty.ty_private = Asttypes.Private in
           ( match ty.ty_manifest with
           | None -> []
-          | Some typ ->
+          | Some (Other typ) ->
               (Raw " = ") ::
               (Raw (if priv then "private " else "")) ::
-              (self#text_of_short_type_expr (Name.father ty.ty_name) typ) ) @
+              (self#text_of_short_type_expr (Name.father ty.ty_name) typ)
+          | Some (Object_type l) ->
+               (Raw (" = "^(if priv then "private " else "")^"{\n")) ::
+               (List.flatten
+                  (List.map
+                     (fun r ->
+                       [ Raw ("  " ^ r.of_name ^ " : ") ] @
+                       (self#text_of_short_type_expr
+                          (Name.father r.of_name)
+                          r.of_type) @
+                       [ Raw " ;" ] @
+                       (entry_doc r.of_text))
+                     l ) )
+               @  [ Raw " }" ]
+          ) @
           (
            match ty.ty_kind with
            | Type_abstract -> [ Newline ]
@@ -673,13 +692,8 @@ class texi =
                        (Raw ("  | " ^ constr.vc_name)) ::
                        (Raw (self#string_of_type_args
                                constr.vc_args constr.vc_ret)) ::
-                       (match constr.vc_text with
-                       | None -> [ Newline ]
-                       | Some t ->
-                           (Raw (indent 5 "\n(*\n ") ::
-                            self#soft_fix_linebreaks 8 (self#text_of_info (Some t))) @
-                           [ Raw " *)" ; Newline ]
-                       ) ) l ) )
+                         (entry_doc constr.vc_text)
+                         ) l ) )
            | Type_record l ->
                (Raw (" = "^(if priv then "private " else "")^"{\n")) ::
                (List.flatten
@@ -690,19 +704,61 @@ class texi =
                           (Name.father r.rf_name)
                           r.rf_type) @
                        [ Raw " ;" ] @
-                       (match r.rf_text with
-                       | None -> [ Newline ]
-                       | Some t ->
-                           ((Raw (indent 5 "\n(*\n ")) ::
-                           (self#soft_fix_linebreaks 8 (self#text_of_info (Some t)))) @
-                           [ Raw " *)" ; Newline ] ) )
+                        (entry_doc r.rf_text)
+                        )
                      l ) )
                @  [ Raw " }" ]
+           | Type_open -> [ Raw " = .." ; Newline ]
           ) ) ;
           self#index `Type ty.ty_name ; Newline ] @
         (self#text_of_info ty.ty_info) in
       self#texi_of_text t
 
+    (** Return Texinfo code for a type extension. *)
+    method texi_of_type_extension m_name te =
+      Odoc_info.reset_type_names () ;
+      let t =
+        ( self#fixedblock (
+            [ Newline ; minus ;
+              Raw "type " ;
+              Raw (match te.te_type_parameters with
+                     | [] -> ""
+                     | [ tp ] ->
+                         Printf.sprintf "%s "
+                           (Odoc_info.string_of_type_expr tp)
+                     | l ->
+                         Printf.sprintf "(%s) "
+                           (String.concat ", "
+                              (List.map Odoc_info.string_of_type_expr l))) ;
+              Raw (self#relative_idents m_name te.te_type_name) ;
+              Raw (" +=" ^
+                      (if te.te_private = Asttypes.Private
+                       then " private" else "")^"\n") ] @
+              (List.flatten
+                 (List.map
+                    (fun x ->
+                       (Raw ("  | " ^ (Name.simple x.xt_name))) ::
+                         (Raw (self#string_of_type_args
+                                 x.xt_args x.xt_ret)) ::
+                         (match x.xt_alias with
+                            | None -> []
+                            | Some xa ->
+                                [ Raw " = " ;
+                                  Raw ( match xa.xa_xt with
+                                          | None -> xa.xa_name
+                                          | Some x -> x.xt_name ) ]) @
+                         (match x.xt_text with
+                            | None -> [ Newline ]
+                            | Some t ->
+                                (Raw (indent 5 "\n(* ") ::
+                                   self#soft_fix_linebreaks 8
+                                     (self#text_of_info (Some t))) @
+                                  [ Raw " *)" ; Newline ] ) @
+                         [self#index `Extension x.xt_name ] )
+                    te.te_constructors ) ) ) ) ::
+          (self#text_of_info te.te_info) in
+        self#texi_of_text t
+
     (** Return Texinfo code for an exception. *)
     method texi_of_exception e =
       Odoc_info.reset_type_names () ;
@@ -710,7 +766,7 @@ class texi =
         [ self#fixedblock
             ( [ Newline ; minus ; Raw "exception " ;
                 Raw (Name.simple e.ex_name) ;
-                Raw (self#string_of_type_args e.ex_args None) ] @
+                Raw (self#string_of_type_args e.ex_args e.ex_ret) ] @
               (match e.ex_alias with
               | None -> []
               | Some ea -> [ Raw " = " ; Raw
@@ -838,6 +894,7 @@ class texi =
       | Element_class c -> self#texi_of_class c
       | Element_class_type ct -> self#texi_of_class_type ct
       | Element_value v -> self#texi_of_value v
+      | Element_type_extension te -> self#texi_of_type_extension module_name te
       | Element_exception e -> self#texi_of_exception e
       | Element_type t -> self#texi_of_type t
       | Element_module_comment t ->
@@ -1198,6 +1255,7 @@ class texi =
     method scan_for_index_in_mod = function
         (* no recursion *)
       | Element_value _ -> self#do_index `Value
+      | Element_type_extension _ -> self#do_index `Extension
       | Element_exception _ -> self#do_index `Exception
       | Element_type _ -> self#do_index `Type
       | Element_included_module _
diff --git a/ocamldoc/odoc_text.ml b/ocamldoc/odoc_text.ml
index 4fd30e0ee9..eb3c562691 100644
--- a/ocamldoc/odoc_text.ml
+++ b/ocamldoc/odoc_text.ml
@@ -128,6 +128,7 @@ module Texter =
                    | RK_class_type -> "classtype"
                    | RK_value -> "val"
                    | RK_type -> "type"
+                   | RK_extension -> "extension"
                    | RK_exception -> "exception"
                    | RK_attribute -> "attribute"
                    | RK_method -> "method"
diff --git a/ocamldoc/odoc_text_lexer.mll b/ocamldoc/odoc_text_lexer.mll
index aaaff10578..c8dda36aa9 100644
--- a/ocamldoc/odoc_text_lexer.mll
+++ b/ocamldoc/odoc_text_lexer.mll
@@ -151,6 +151,7 @@ let end_verb = blank_nl"v}"
 let begin_ele_ref = "{!"blank_nl | "{!"
 let begin_val_ref = "{!val:"blank_nl | "{!val:"
 let begin_typ_ref = "{!type:"blank_nl | "{!type:"
+let begin_ext_ref = "{!extension:"blank_nl | "{!extension:"
 let begin_exc_ref = "{!exception:"blank_nl | "{!exception:"
 let begin_mod_ref = "{!module:"blank_nl | "{!module:"
 let begin_modt_ref = "{!modtype:"blank_nl | "{!modtype:"
@@ -529,6 +530,23 @@ rule main = parse
           )
     }
 
+| begin_ext_ref
+    {
+      incr_cpts lexbuf ;
+      if !verb_mode || !target_mode || !code_pre_mode || !open_brackets >= 1 then
+        Char (Lexing.lexeme lexbuf)
+      else
+        if not !ele_ref_mode then
+          (
+           ele_ref_mode := true;
+           EXT_REF
+          )
+        else
+          (
+           Char (Lexing.lexeme lexbuf)
+          )
+    }
+
 | begin_exc_ref
     {
       incr_cpts lexbuf ;
diff --git a/ocamldoc/odoc_text_parser.mly b/ocamldoc/odoc_text_parser.mly
index c10425ccb4..b4118c4f21 100644
--- a/ocamldoc/odoc_text_parser.mly
+++ b/ocamldoc/odoc_text_parser.mly
@@ -52,6 +52,7 @@ let print_DEBUG s = print_string s; print_newline ()
 %token ELE_REF
 %token VAL_REF
 %token TYP_REF
+%token EXT_REF
 %token EXC_REF
 %token MOD_REF
 %token MODT_REF
@@ -113,6 +114,7 @@ ele_ref_kind:
   ELE_REF { None }
 | VAL_REF { Some RK_value }
 | TYP_REF { Some RK_type }
+| EXT_REF { Some RK_extension }
 | EXC_REF { Some RK_exception }
 | MOD_REF { Some RK_module }
 | MODT_REF { Some RK_module_type }
diff --git a/ocamldoc/odoc_to_text.ml b/ocamldoc/odoc_to_text.ml
index c913875704..1c7f6ba7fb 100644
--- a/ocamldoc/odoc_to_text.ml
+++ b/ocamldoc/odoc_to_text.ml
@@ -336,29 +336,36 @@ class virtual to_text =
     (** @return [text] value for an exception. *)
     method text_of_exception e =
       let s_name = Name.simple e.ex_name in
+      let father = Name.father e.ex_name in
       Format.fprintf Format.str_formatter "@[<hov 2>exception %s" s_name ;
-        (match e.ex_args with
-          [] -> ()
-        | _ ->
-            Format.fprintf Format.str_formatter "@ of "
-        );
-      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
-          None -> ()
-        | Some ea ->
-            Format.fprintf Format.str_formatter " = %s"
-              (
-               match ea.ea_ex with
-                 None -> ea.ea_name
-               | Some e -> e.ex_name
-              )
-        );
-        Format.flush_str_formatter ()
-      in
+      (match e.ex_args, e.ex_ret with
+         [], None -> ()
+       | l, None ->
+           Format.fprintf Format.str_formatter " %s@ %s"
+             "of"
+             (self#normal_type_list ~par: false father " * " l)
+       | [], Some r ->
+           Format.fprintf Format.str_formatter " %s@ %s"
+             ":"
+             (self#normal_type father r)
+       | l, Some r ->
+           Format.fprintf Format.str_formatter " %s@ %s@ %s@ %s"
+             ":"
+             (self#normal_type_list ~par: false father " * " l)
+             "->"
+             (self#normal_type father r)
+      );
+      (match e.ex_alias with
+         None -> ()
+       | Some ea ->
+           Format.fprintf Format.str_formatter " = %s"
+            (
+              match ea.ea_ex with
+                None -> ea.ea_name
+              | Some e -> e.ex_name
+            )
+      );
+      let s2 = Format.flush_str_formatter () in
       [ CodePre s2 ] @
       [Latex ("\\index{"^(self#label s_name)^"@\\verb`"^(self#label ~no_:false s_name)^"`}\n")] @
       (self#text_of_info e.ex_info)
diff --git a/ocamldoc/odoc_type.ml b/ocamldoc/odoc_type.ml
index ef9699e607..dadc6b1bad 100644
--- a/ocamldoc/odoc_type.ml
+++ b/ocamldoc/odoc_type.ml
@@ -40,6 +40,17 @@ type type_kind =
                    (** constructors *)
   | Type_record of record_field list
                    (** fields *)
+  | Type_open
+
+type object_field = {
+  of_name : string ;
+  of_type : Types.type_expr ;
+  mutable of_text : Odoc_types.info option ; (** optional user description *)
+}
+
+type type_manifest =
+  | Other of Types.type_expr (** Type manifest directly taken from Typedtre. *)
+  | Object_type of object_field list
 
 (** Representation of a type. *)
 type t_type = {
@@ -49,7 +60,7 @@ type t_type = {
                     (** type parameters: (type, covariant, contravariant) *)
     ty_kind : type_kind ;
     ty_private : private_flag;
-    ty_manifest : Types.type_expr option; (** type manifest *)
+    ty_manifest : type_manifest option;
     mutable ty_loc : Odoc_types.location ;
     mutable ty_code : string option;
   }
diff --git a/ocamldoc/odoc_types.ml b/ocamldoc/odoc_types.ml
index eccc852d67..9d7824aae1 100644
--- a/ocamldoc/odoc_types.ml
+++ b/ocamldoc/odoc_types.ml
@@ -17,6 +17,7 @@ type ref_kind =
   | RK_class_type
   | RK_value
   | RK_type
+  | RK_extension
   | RK_exception
   | RK_attribute
   | RK_method
diff --git a/ocamldoc/odoc_types.mli b/ocamldoc/odoc_types.mli
index 7819a2346b..f9456ccd85 100644
--- a/ocamldoc/odoc_types.mli
+++ b/ocamldoc/odoc_types.mli
@@ -20,6 +20,7 @@ type ref_kind =
   | RK_class_type
   | RK_value
   | RK_type
+  | RK_extension
   | RK_exception
   | RK_attribute
   | RK_method
diff --git a/otherlibs/Makefile.shared b/otherlibs/Makefile.shared
index 6c2fc5d67a..9bed5f7604 100644
--- a/otherlibs/Makefile.shared
+++ b/otherlibs/Makefile.shared
@@ -19,7 +19,7 @@ include $(ROOTDIR)/config/Makefile
 # Compilation options
 CC=$(BYTECC)
 CAMLRUN=$(ROOTDIR)/boot/ocamlrun
-COMPFLAGS=-w +33..39 -warn-error A -bin-annot -g $(EXTRACAMLFLAGS)
+COMPFLAGS=-w +33..39 -warn-error A -bin-annot -g -safe-string $(EXTRACAMLFLAGS)
 MKLIB=$(CAMLRUN) $(ROOTDIR)/tools/ocamlmklib
 
 # Variables to be defined by individual libraries:
diff --git a/otherlibs/bigarray/.depend b/otherlibs/bigarray/.depend
index 4df63a3e32..d705f2022e 100644
--- a/otherlibs/bigarray/.depend
+++ b/otherlibs/bigarray/.depend
@@ -1,21 +1,21 @@
 bigarray_stubs.o: bigarray_stubs.c ../../byterun/alloc.h \
- ../../byterun/misc.h ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/mlvalues.h bigarray.h \
- ../../byterun/config.h ../../byterun/mlvalues.h ../../byterun/custom.h \
- ../../byterun/fail.h ../../byterun/intext.h ../../byterun/io.h \
- ../../byterun/hash.h ../../byterun/memory.h ../../byterun/gc.h \
- ../../byterun/major_gc.h ../../byterun/freelist.h \
- ../../byterun/minor_gc.h ../../byterun/int64_native.h
+  ../../byterun/misc.h ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/mlvalues.h bigarray.h \
+  ../../byterun/config.h ../../byterun/mlvalues.h ../../byterun/custom.h \
+  ../../byterun/fail.h ../../byterun/intext.h ../../byterun/io.h \
+  ../../byterun/hash.h ../../byterun/memory.h ../../byterun/gc.h \
+  ../../byterun/major_gc.h ../../byterun/freelist.h \
+  ../../byterun/minor_gc.h ../../byterun/int64_native.h
 mmap_unix.o: mmap_unix.c bigarray.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../byterun/mlvalues.h ../../byterun/config.h ../../byterun/misc.h \
- ../../byterun/custom.h ../../byterun/mlvalues.h ../../byterun/fail.h \
- ../../byterun/io.h ../../byterun/sys.h ../../byterun/signals.h
+  ../../byterun/../config/m.h ../../byterun/../config/s.h \
+  ../../byterun/mlvalues.h ../../byterun/config.h ../../byterun/misc.h \
+  ../../byterun/custom.h ../../byterun/mlvalues.h ../../byterun/fail.h \
+  ../../byterun/io.h ../../byterun/sys.h ../../byterun/signals.h
 mmap_win32.o: mmap_win32.c bigarray.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../byterun/mlvalues.h ../../byterun/config.h ../../byterun/misc.h \
- ../../byterun/alloc.h ../../byterun/mlvalues.h ../../byterun/custom.h \
- ../../byterun/fail.h ../../byterun/sys.h ../unix/unixsupport.h
+  ../../byterun/../config/m.h ../../byterun/../config/s.h \
+  ../../byterun/mlvalues.h ../../byterun/config.h ../../byterun/misc.h \
+  ../../byterun/alloc.h ../../byterun/mlvalues.h ../../byterun/custom.h \
+  ../../byterun/fail.h ../../byterun/sys.h ../unix/unixsupport.h
 bigarray.cmi :
 bigarray.cmo : bigarray.cmi
 bigarray.cmx : bigarray.cmi
diff --git a/otherlibs/bigarray/mmap_unix.c b/otherlibs/bigarray/mmap_unix.c
index 8a93a06b11..cdcfe3ce32 100644
--- a/otherlibs/bigarray/mmap_unix.c
+++ b/otherlibs/bigarray/mmap_unix.c
@@ -153,7 +153,7 @@ CAMLprim value caml_ba_map_file(value vfd, value vkind, value vlayout,
     }
   }
   /* Determine offset so that the mapping starts at the given file pos */
-  page = getpagesize();
+  page = sysconf(_SC_PAGESIZE);
   delta = (uintnat) startpos % page;
   /* Do the mmap */
   shared = Bool_val(vshared) ? MAP_SHARED : MAP_PRIVATE;
@@ -189,7 +189,7 @@ CAMLprim value caml_ba_map_file_bytecode(value * argv, int argn)
 void caml_ba_unmap_file(void * addr, uintnat len)
 {
 #if defined(HAS_MMAP)
-  uintnat page = getpagesize();
+  uintnat page = sysconf(_SC_PAGESIZE);
   uintnat delta = (uintnat) addr % page;
   if (len == 0) return;         /* PR#5463 */
   addr = (void *)((uintnat)addr - delta);
diff --git a/otherlibs/dynlink/Makefile b/otherlibs/dynlink/Makefile
index 15b01921bb..6284a5283e 100644
--- a/otherlibs/dynlink/Makefile
+++ b/otherlibs/dynlink/Makefile
@@ -21,7 +21,8 @@ OCAMLC    = $(OCAMLRUN) $(ROOTDIR)/ocamlc -nostdlib -I $(ROOTDIR)/stdlib
 OCAMLOPT  = $(OCAMLRUN) $(ROOTDIR)/ocamlopt -nostdlib -I $(ROOTDIR)/stdlib
 
 INCLUDES=-I ../../utils -I ../../typing -I ../../bytecomp -I ../../asmcomp
-COMPFLAGS=-w +33..39 -warn-error A -bin-annot -I ../../stdlib $(INCLUDES)
+COMPFLAGS=-w +33..39 -warn-error A -bin-annot -safe-string \
+          -I ../../stdlib $(INCLUDES)
 
 OBJS=dynlinkaux.cmo dynlink.cmo
 
diff --git a/otherlibs/dynlink/dynlink.ml b/otherlibs/dynlink/dynlink.ml
index fee98f1c1b..47409ad361 100644
--- a/otherlibs/dynlink/dynlink.ml
+++ b/otherlibs/dynlink/dynlink.ml
@@ -79,13 +79,16 @@ let allow_extension = ref true
 let check_consistency file_name cu =
   try
     List.iter
-      (fun (name, crc) ->
-        if name = cu.cu_name then
-          Consistbl.set !crc_interfaces name crc file_name
-        else if !allow_extension then
-          Consistbl.check !crc_interfaces name crc file_name
-        else
-          Consistbl.check_noadd !crc_interfaces name crc file_name)
+      (fun (name, crco) ->
+         match crco with
+           None -> ()
+         | Some crc ->
+             if name = cu.cu_name then
+               Consistbl.set !crc_interfaces name crc file_name
+             else if !allow_extension then
+               Consistbl.check !crc_interfaces name crc file_name
+             else
+               Consistbl.check_noadd !crc_interfaces name crc file_name)
       cu.cu_imports
   with Consistbl.Inconsistency(name, user, auth) ->
          raise(Error(Inconsistent_import name))
@@ -113,15 +116,21 @@ let prohibit names =
 (* Initialize the crc_interfaces table with a list of units with fixed CRCs *)
 
 let add_available_units units =
-  List.iter (fun (unit, crc) -> Consistbl.set !crc_interfaces unit crc "")
-            units
+  List.iter
+    (fun (unit, crc) -> Consistbl.set !crc_interfaces unit crc "")
+    units
 
 (* Default interface CRCs: those found in the current executable *)
 let default_crcs = ref []
 
 let default_available_units () =
   clear_available_units();
-  add_available_units !default_crcs;
+  List.iter
+    (fun (unit, crco) ->
+       match crco with
+         None -> ()
+       | Some crc -> Consistbl.set !crc_interfaces unit crc "")
+    !default_crcs;
   allow_extension := true
 
 (* Initialize the linker tables and everything *)
@@ -152,7 +161,9 @@ let digest_interface unit loadpath =
       raise (Error(File_not_found shortname)) in
   let ic = open_in_bin filename in
   try
-    let buffer = Misc.input_bytes ic (String.length Config.cmi_magic_number) in
+    let buffer =
+      really_input_string ic (String.length Config.cmi_magic_number)
+    in
     if buffer <> Config.cmi_magic_number then begin
       close_in ic;
       raise(Error(Corrupted_interface filename))
@@ -161,7 +172,7 @@ let digest_interface unit loadpath =
     close_in ic;
     let crc =
       match cmi.Cmi_format.cmi_crcs with
-        (_, crc) :: _ -> crc
+        (_, Some crc) :: _ -> crc
       | _             -> raise(Error(Corrupted_interface filename))
     in
     crc
@@ -189,7 +200,7 @@ let check_unsafe_module cu =
 
 (* Load in-core and execute a bytecode object file *)
 
-external register_code_fragment: string -> int -> string -> unit
+external register_code_fragment: bytes -> int -> string -> unit
                                = "caml_register_code_fragment"
 
 let load_compunit ic file_name file_digest compunit =
@@ -199,14 +210,14 @@ let load_compunit ic file_name file_digest compunit =
   let code_size = compunit.cu_codesize + 8 in
   let code = Meta.static_alloc code_size in
   unsafe_really_input ic code 0 compunit.cu_codesize;
-  String.unsafe_set code compunit.cu_codesize (Char.chr Opcodes.opRETURN);
-  String.unsafe_set code (compunit.cu_codesize + 1) '\000';
-  String.unsafe_set code (compunit.cu_codesize + 2) '\000';
-  String.unsafe_set code (compunit.cu_codesize + 3) '\000';
-  String.unsafe_set code (compunit.cu_codesize + 4) '\001';
-  String.unsafe_set code (compunit.cu_codesize + 5) '\000';
-  String.unsafe_set code (compunit.cu_codesize + 6) '\000';
-  String.unsafe_set code (compunit.cu_codesize + 7) '\000';
+  Bytes.unsafe_set code compunit.cu_codesize (Char.chr Opcodes.opRETURN);
+  Bytes.unsafe_set code (compunit.cu_codesize + 1) '\000';
+  Bytes.unsafe_set code (compunit.cu_codesize + 2) '\000';
+  Bytes.unsafe_set code (compunit.cu_codesize + 3) '\000';
+  Bytes.unsafe_set code (compunit.cu_codesize + 4) '\001';
+  Bytes.unsafe_set code (compunit.cu_codesize + 5) '\000';
+  Bytes.unsafe_set code (compunit.cu_codesize + 6) '\000';
+  Bytes.unsafe_set code (compunit.cu_codesize + 7) '\000';
   let initial_symtable = Symtable.current_state() in
   begin try
     Symtable.patch_object code compunit.cu_reloc;
@@ -242,7 +253,7 @@ let loadfile file_name =
   seek_in ic 0;
   try
     let buffer =
-      try Misc.input_bytes ic (String.length Config.cmo_magic_number)
+      try really_input_string ic (String.length Config.cmo_magic_number)
       with End_of_file -> raise (Error (Not_a_bytecode_file file_name))
     in
     if buffer = Config.cmo_magic_number then begin
diff --git a/otherlibs/dynlink/natdynlink.ml b/otherlibs/dynlink/natdynlink.ml
index fd06d7c70c..597d60fb5f 100644
--- a/otherlibs/dynlink/natdynlink.ml
+++ b/otherlibs/dynlink/natdynlink.ml
@@ -15,9 +15,9 @@
 
 type handle
 
-external ndl_open: string -> bool -> handle * string = "caml_natdynlink_open"
+external ndl_open: string -> bool -> handle * bytes = "caml_natdynlink_open"
 external ndl_run: handle -> string -> unit = "caml_natdynlink_run"
-external ndl_getmap: unit -> string = "caml_natdynlink_getmap"
+external ndl_getmap: unit -> bytes = "caml_natdynlink_getmap"
 external ndl_globals_inited: unit -> int = "caml_natdynlink_globals_inited"
 
 type linking_error =
@@ -41,11 +41,7 @@ exception Error of error
 open Cmx_format
 
 (* Copied from config.ml to avoid dependencies *)
-let cmxs_magic_number = "Caml2007D001"
-
-(* Copied from compilenv.ml to avoid dependencies *)
-let cmx_not_found_crc =
-  "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000"
+let cmxs_magic_number = "Caml2007D002"
 
 let dll_filename fname =
   if Filename.is_implicit fname then Filename.concat (Sys.getcwd ()) fname
@@ -59,7 +55,7 @@ let read_file filename priv =
   if Obj.tag (Obj.repr res) = Obj.string_tag
   then raise (Error (Cannot_open_dll (Obj.magic res)));
 
-  let header : dynheader = Marshal.from_string data 0 in
+  let header : dynheader = Marshal.from_bytes data 0 in
   if header.dynu_magic <> cmxs_magic_number
   then raise(Error(Not_a_bytecode_file dll));
   (dll, handle, header.dynu_units)
@@ -92,7 +88,7 @@ let inited = ref false
 
 let default_available_units () =
   let map : (string*Digest.t*Digest.t*string list) list =
-    Marshal.from_string (ndl_getmap ()) 0 in
+    Marshal.from_bytes (ndl_getmap ()) 0 in
   let exe = Sys.executable_name in
   let rank = ref 0 in
   global_state :=
@@ -114,23 +110,26 @@ let init () =
 
 let add_check_ifaces allow_ext filename ui ifaces =
   List.fold_left
-    (fun ifaces (name, crc) ->
-       if name = ui.dynu_name
-       then StrMap.add name (crc,filename) ifaces
-       else
-         try
-           let (old_crc,old_src) = StrMap.find name ifaces in
-           if old_crc <> crc
-           then raise(Error(Inconsistent_import(name)))
-           else ifaces
-         with Not_found ->
-           if allow_ext then StrMap.add name (crc,filename) ifaces
-           else raise (Error(Unavailable_unit name))
+    (fun ifaces (name, crco) ->
+       match crco with
+         None -> ifaces
+       | Some crc ->
+           if name = ui.dynu_name
+           then StrMap.add name (crc,filename) ifaces
+           else
+             try
+               let (old_crc,old_src) = StrMap.find name ifaces in
+                 if old_crc <> crc
+                 then raise(Error(Inconsistent_import(name)))
+                 else ifaces
+             with Not_found ->
+               if allow_ext then StrMap.add name (crc,filename) ifaces
+               else raise (Error(Unavailable_unit name))
     ) ifaces ui.dynu_imports_cmi
 
 let check_implems filename ui implems =
   List.iter
-    (fun (name, crc) ->
+    (fun (name, crco) ->
        match name with
          |"Out_of_memory"
          |"Sys_error"
@@ -147,13 +146,15 @@ let check_implems filename ui implems =
          | _ ->
        try
          let (old_crc,old_src,state) = StrMap.find name implems in
-         if crc <> cmx_not_found_crc && old_crc <> crc
-         then raise(Error(Inconsistent_implementation(name)))
-         else match state with
-           | Check_inited i ->
-               if ndl_globals_inited() < i
-               then raise(Error(Unavailable_unit name))
-           | Loaded -> ()
+           match crco with
+             Some crc when old_crc <> crc ->
+               raise(Error(Inconsistent_implementation(name)))
+           | _ ->
+               match state with
+               | Check_inited i ->
+                   if ndl_globals_inited() < i
+                   then raise(Error(Unavailable_unit name))
+               | Loaded -> ()
        with Not_found ->
          raise (Error(Unavailable_unit name))
     ) ui.dynu_imports_cmx
diff --git a/otherlibs/graph/.depend b/otherlibs/graph/.depend
index b4b531d43a..ab9faa619a 100644
--- a/otherlibs/graph/.depend
+++ b/otherlibs/graph/.depend
@@ -1,63 +1,103 @@
-color.o: color.c libgraph.h ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../byterun/misc.h
-draw.o: draw.c libgraph.h ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h
-dump_img.o: dump_img.c libgraph.h ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../byterun/misc.h image.h ../../byterun/alloc.h \
- ../../byterun/mlvalues.h ../../byterun/memory.h ../../byterun/gc.h \
- ../../byterun/major_gc.h ../../byterun/freelist.h \
- ../../byterun/minor_gc.h
-events.o: events.c libgraph.h ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \
- ../../byterun/signals.h
-fill.o: fill.c libgraph.h ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../byterun/misc.h ../../byterun/memory.h ../../byterun/gc.h \
- ../../byterun/mlvalues.h ../../byterun/major_gc.h \
- ../../byterun/freelist.h ../../byterun/minor_gc.h
-image.o: image.c libgraph.h ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../byterun/misc.h image.h ../../byterun/alloc.h \
- ../../byterun/mlvalues.h ../../byterun/custom.h
-make_img.o: make_img.c libgraph.h ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../byterun/misc.h image.h ../../byterun/memory.h ../../byterun/gc.h \
- ../../byterun/mlvalues.h ../../byterun/major_gc.h \
- ../../byterun/freelist.h ../../byterun/minor_gc.h
-open.o: open.c libgraph.h ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \
- ../../byterun/callback.h ../../byterun/fail.h ../../byterun/memory.h \
- ../../byterun/gc.h ../../byterun/major_gc.h ../../byterun/freelist.h \
- ../../byterun/minor_gc.h
-point_col.o: point_col.c libgraph.h ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../byterun/misc.h
-sound.o: sound.c libgraph.h ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../byterun/misc.h
-subwindow.o: subwindow.c libgraph.h ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../byterun/misc.h
-text.o: text.c libgraph.h ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h
+color.o: color.c libgraph.h \
+  \
+  \
+  \
+  ../../byterun/mlvalues.h ../../byterun/compatibility.h \
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/misc.h \
+ 
+draw.o: draw.c libgraph.h \
+  \
+  \
+  \
+  ../../byterun/mlvalues.h ../../byterun/compatibility.h \
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \
+  ../../byterun/mlvalues.h
+dump_img.o: dump_img.c libgraph.h \
+  \
+  \
+  \
+  ../../byterun/mlvalues.h ../../byterun/compatibility.h \
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/misc.h image.h \
+  ../../byterun/alloc.h ../../byterun/mlvalues.h ../../byterun/memory.h \
+  ../../byterun/gc.h ../../byterun/major_gc.h ../../byterun/freelist.h \
+  ../../byterun/minor_gc.h
+events.o: events.c libgraph.h \
+  \
+  \
+  \
+  ../../byterun/mlvalues.h ../../byterun/compatibility.h \
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \
+  ../../byterun/mlvalues.h ../../byterun/signals.h
+fill.o: fill.c libgraph.h \
+  \
+  \
+  \
+  ../../byterun/mlvalues.h ../../byterun/compatibility.h \
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/memory.h \
+  ../../byterun/gc.h ../../byterun/mlvalues.h ../../byterun/major_gc.h \
+  ../../byterun/freelist.h ../../byterun/minor_gc.h
+image.o: image.c libgraph.h \
+  \
+  \
+  \
+  ../../byterun/mlvalues.h ../../byterun/compatibility.h \
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/misc.h image.h \
+  ../../byterun/alloc.h ../../byterun/mlvalues.h ../../byterun/custom.h
+make_img.o: make_img.c libgraph.h \
+  \
+  \
+  \
+  ../../byterun/mlvalues.h ../../byterun/compatibility.h \
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/misc.h image.h \
+  ../../byterun/memory.h ../../byterun/gc.h ../../byterun/mlvalues.h \
+  ../../byterun/major_gc.h ../../byterun/freelist.h \
+  ../../byterun/minor_gc.h
+open.o: open.c libgraph.h \
+  \
+  \
+  \
+  ../../byterun/mlvalues.h ../../byterun/compatibility.h \
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \
+  ../../byterun/mlvalues.h ../../byterun/callback.h ../../byterun/fail.h \
+  ../../byterun/memory.h ../../byterun/gc.h ../../byterun/major_gc.h \
+  ../../byterun/freelist.h ../../byterun/minor_gc.h
+point_col.o: point_col.c libgraph.h \
+  \
+  \
+  \
+  ../../byterun/mlvalues.h ../../byterun/compatibility.h \
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/misc.h
+sound.o: sound.c libgraph.h \
+  \
+  \
+  \
+  ../../byterun/mlvalues.h ../../byterun/compatibility.h \
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/misc.h
+subwindow.o: subwindow.c libgraph.h \
+  \
+  \
+  \
+  ../../byterun/mlvalues.h ../../byterun/compatibility.h \
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/misc.h
+text.o: text.c libgraph.h \
+  \
+  \
+  \
+  ../../byterun/mlvalues.h ../../byterun/compatibility.h \
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \
+  ../../byterun/mlvalues.h
 graphics.cmi :
 graphicsX11.cmi :
 graphics.cmo : graphics.cmi
diff --git a/otherlibs/graph/libgraph.h b/otherlibs/graph/libgraph.h
index e75ee801cc..71204e3133 100644
--- a/otherlibs/graph/libgraph.h
+++ b/otherlibs/graph/libgraph.h
@@ -15,6 +15,7 @@
 #include <X11/Xlib.h>
 #include <X11/Xutil.h>
 #include <mlvalues.h>
+#include <misc.h>
 
 struct canvas {
   int w, h;                     /* Dimensions of the drawable */
@@ -73,7 +74,7 @@ extern int caml_gr_bits_per_pixel;
 #endif
 #endif
 
-extern void caml_gr_fail(char *fmt, char *arg);
+extern void caml_gr_fail(char *fmt, char *arg) Noreturn;
 extern void caml_gr_check_open(void);
 extern unsigned long caml_gr_pixel_rgb(int rgb);
 extern int caml_gr_rgb_pixel(long unsigned int pixel);
diff --git a/otherlibs/num/.depend b/otherlibs/num/.depend
index 32d691cc80..51b180f5d8 100644
--- a/otherlibs/num/.depend
+++ b/otherlibs/num/.depend
@@ -1,6 +1,6 @@
 bng.o: bng.c bng.h ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/compatibility.h bng_amd64.c \
- bng_digit.c
+  ../../byterun/../config/s.h ../../byterun/compatibility.h bng_amd64.c \
+  bng_digit.c
 bng_amd64.o: bng_amd64.c
 bng_arm64.o: bng_arm64.c
 bng_digit.o: bng_digit.c
@@ -8,14 +8,14 @@ bng_ia32.o: bng_ia32.c
 bng_ppc.o: bng_ppc.c
 bng_sparc.o: bng_sparc.c
 nat_stubs.o: nat_stubs.c ../../byterun/alloc.h \
- ../../byterun/compatibility.h ../../byterun/misc.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/mlvalues.h \
- ../../byterun/config.h ../../byterun/custom.h ../../byterun/intext.h \
- ../../byterun/io.h ../../byterun/fail.h ../../byterun/hash.h \
- ../../byterun/memory.h ../../byterun/gc.h ../../byterun/major_gc.h \
- ../../byterun/freelist.h ../../byterun/minor_gc.h \
- ../../byterun/mlvalues.h bng.h nat.h
+  ../../byterun/compatibility.h ../../byterun/misc.h \
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/mlvalues.h \
+  ../../byterun/config.h ../../byterun/custom.h ../../byterun/intext.h \
+  ../../byterun/io.h ../../byterun/fail.h ../../byterun/hash.h \
+  ../../byterun/memory.h ../../byterun/gc.h ../../byterun/major_gc.h \
+  ../../byterun/freelist.h ../../byterun/minor_gc.h \
+  ../../byterun/mlvalues.h bng.h nat.h
 arith_flags.cmi :
 arith_status.cmi :
 big_int.cmi : nat.cmi
diff --git a/otherlibs/num/big_int.ml b/otherlibs/num/big_int.ml
index 939bbfb8ee..847d158324 100644
--- a/otherlibs/num/big_int.ml
+++ b/otherlibs/num/big_int.ml
@@ -625,15 +625,15 @@ let square_big_int bi =
    else s <- the round number and the result_int is false *)
 let round_futur_last_digit s off_set length =
  let l = pred (length + off_set) in
-  if Char.code(String.get s l) >= Char.code '5'
+  if Char.code(Bytes.get s l) >= Char.code '5'
     then
      let rec round_rec l =
        if l < off_set then true else begin
-         let current_char = String.get s l in
+         let current_char = Bytes.get s l in
          if current_char = '9' then
-           (String.set s l '0'; round_rec (pred l))
+           (Bytes.set s l '0'; round_rec (pred l))
          else
-           (String.set s l (Char.chr (succ (Char.code current_char)));
+           (Bytes.set s l (Char.chr (succ (Char.code current_char)));
             false)
        end
      in round_rec (pred l)
@@ -652,17 +652,19 @@ let approx_big_int prec bi =
                                       (big_int_of_string "963295986"))
                         (big_int_of_string "100000000")))) in
   let s =
-    string_of_big_int (div_big_int bi (power_int_positive_int 10 n)) in
+    Bytes.unsafe_of_string
+      (string_of_big_int (div_big_int bi (power_int_positive_int 10 n)))
+  in
   let (sign, off, len) =
-    if String.get s 0 = '-'
+    if Bytes.get s 0 = '-'
        then ("-", 1, succ prec)
        else ("", 0, prec) in
   if (round_futur_last_digit s off (succ prec))
        then (sign^"1."^(String.make prec '0')^"e"^
-             (string_of_int (n + 1 - off + String.length s)))
-       else (sign^(String.sub s off 1)^"."^
-             (String.sub s (succ off) (pred prec))
-             ^"e"^(string_of_int (n - succ off + String.length s)))
+             (string_of_int (n + 1 - off + Bytes.length s)))
+       else (sign^(Bytes.sub_string s off 1)^"."^
+             (Bytes.sub_string s (succ off) (pred prec))
+             ^"e"^(string_of_int (n - succ off + Bytes.length s)))
 
 (* Logical operations *)
 
diff --git a/otherlibs/num/big_int.mli b/otherlibs/num/big_int.mli
index 276108f902..738730a79a 100644
--- a/otherlibs/num/big_int.mli
+++ b/otherlibs/num/big_int.mli
@@ -187,5 +187,5 @@ val nat_of_big_int : big_int -> nat
 val big_int_of_nat : nat -> big_int
 val base_power_big_int: int -> int -> big_int -> big_int
 val sys_big_int_of_string: string -> int -> int -> big_int
-val round_futur_last_digit : string -> int -> int -> bool
+val round_futur_last_digit : bytes -> int -> int -> bool
 val approx_big_int: int -> big_int -> string
diff --git a/otherlibs/num/nat.ml b/otherlibs/num/nat.ml
index 59f57ee7d8..90cb471c1b 100644
--- a/otherlibs/num/nat.ml
+++ b/otherlibs/num/nat.ml
@@ -282,18 +282,15 @@ let raw_string_of_digit nat off =
        and s1 = string_of_int (nth_digit_nat a_1 0) in
        let len = String.length s1 in
        if leading_digits < 10 then begin
-            let result = String.make (max_superscript_10_power_in_int+1) '0' in
-            String.set result 0
-                         (Char.chr (48 + leading_digits));
-            String.blit s1 0
-                 result (String.length result - len) len;
-            result
+            let result = Bytes.make (max_superscript_10_power_in_int+1) '0' in
+            Bytes.set result 0 (Char.chr (48 + leading_digits));
+            String.blit s1 0 result (Bytes.length result - len) len;
+            Bytes.to_string result
        end else begin
-            let result = String.make (max_superscript_10_power_in_int+2) '0' in
+            let result = Bytes.make (max_superscript_10_power_in_int+2) '0' in
             String.blit (string_of_int leading_digits) 0 result 0 2;
-            String.blit s1 0
-                 result (String.length result - len) len;
-            result
+            String.blit s1 0 result (Bytes.length result - len) len;
+            Bytes.to_string result
        end
   end
 
@@ -344,7 +341,7 @@ let int_to_string int s pos_ref base times =
   let i = ref int
   and j = ref times in
      while ((!i != 0) || (!j != 0)) && (!pos_ref != -1) do
-        String.set s !pos_ref (String.get digits (!i mod base));
+        Bytes.set s !pos_ref (String.get digits (!i mod base));
         decr pos_ref;
         decr j;
         i := !i / base
@@ -466,7 +463,7 @@ let unadjusted_string_of_nat nat off len_nat =
          if len > biggest_int / (succ pmax)
             then failwith "number too long"
             else let len_s = (succ pmax) * len in
-                 let s = String.make len_s '0'
+                 let s = Bytes.make len_s '0'
                  and pos_ref = ref len_s in
                    len_copy := pred !len_copy;
                    blit_nat copy1 0 nat off len;
@@ -488,7 +485,7 @@ let unadjusted_string_of_nat nat off len_nat =
                       blit_nat copy1 0 copy2 0 !len_copy;
                       set_digit_nat copy1 !len_copy 0
                    done;
-                   s
+                   Bytes.unsafe_to_string s
 
 let string_of_nat nat =
   let s = unadjusted_string_of_nat nat 0 (length_nat nat)
diff --git a/otherlibs/num/ratio.ml b/otherlibs/num/ratio.ml
index fe0170f299..5bb04b6474 100644
--- a/otherlibs/num/ratio.ml
+++ b/otherlibs/num/ratio.ml
@@ -438,7 +438,8 @@ let approx_ratio_fix n r =
                    r.denominator)) in
        (* Round up and add 1 in front if needed *)
        let s2 =
-         if round_futur_last_digit s1 0 (String.length s1)
+         if round_futur_last_digit (Bytes.unsafe_of_string s1) 0
+                                   (String.length s1)
          then "1" ^ s1
          else s1 in
        let l2 = String.length s2 - 1 in
@@ -447,18 +448,18 @@ let approx_ratio_fix n r =
             if s2 without last digit is      yy with <= n digits:
                <sign> 0 . 0yy *)
        if l2 > n then begin
-         let s = String.make (l2 + 2) '0' in
-         String.set s 0  (if sign_r = -1 then '-' else '+');
+         let s = Bytes.make (l2 + 2) '0' in
+         Bytes.set s 0  (if sign_r = -1 then '-' else '+');
          String.blit s2 0 s 1 (l2 - n);
-         String.set s (l2 - n + 1) '.';
+         Bytes.set s (l2 - n + 1) '.';
          String.blit s2 (l2 - n) s (l2 - n + 2) n;
-         s
+         Bytes.unsafe_to_string s
        end else begin
-         let s = String.make (n + 3) '0' in
-         String.set s 0  (if sign_r = -1 then '-' else '+');
-         String.set s 2 '.';
+         let s = Bytes.make (n + 3) '0' in
+         Bytes.set s 0  (if sign_r = -1 then '-' else '+');
+         Bytes.set s 2 '.';
          String.blit s2 0 s (n + 3 - l2) l2;
-         s
+         Bytes.unsafe_to_string s
        end
      end else begin
        (* Dubious; what is this code supposed to do? *)
@@ -468,10 +469,10 @@ let approx_ratio_fix n r =
                     (base_power_big_int
                       10 (-n) r.denominator)) in
        let len = succ (String.length s) in
-       let s' = String.make len '0' in
-        String.set s' 0 (if sign_r = -1 then '-' else '+');
+       let s' = Bytes.make len '0' in
+        Bytes.set s' 0 (if sign_r = -1 then '-' else '+');
         String.blit s 0 s' 1 (pred len);
-        s'
+        Bytes.unsafe_to_string s'
      end
 
 (* Number of digits of the decimal representation of an int *)
@@ -488,11 +489,8 @@ let approx_ratio_exp n r =
  else
   let sign_r = sign_ratio r
   and i = ref (n + 3) in
-   if sign_r = 0
-     then
-      let s = String.make (n + 5) '0' in
-       (String.blit "+0." 0 s 0 3);
-       (String.blit "e0" 0 s !i 2); s
+   if sign_r = 0 then
+     String.concat "" ["+0."; String.make n '0'; "e0"]
    else
      let msd = msd_ratio (abs_ratio r) in
      let k = n - msd in
@@ -508,28 +506,29 @@ let approx_ratio_exp n r =
                                 10 k (abs_big_int r.numerator))
                                r.denominator) in
        string_of_nat nat) in
-     if (round_futur_last_digit s 0 (String.length s))
+     if round_futur_last_digit (Bytes.unsafe_of_string s) 0
+                               (String.length s)
       then
        let m = num_decimal_digits_int (succ msd) in
-       let str = String.make (n + m + 4) '0' in
+       let str = Bytes.make (n + m + 4) '0' in
          (String.blit (if sign_r = -1 then "-1." else "+1.") 0 str 0 3);
-         String.set str !i ('e');
+         Bytes.set str !i ('e');
          incr i;
          (if m = 0
-          then String.set str !i '0'
+          then Bytes.set str !i '0'
           else String.blit (string_of_int (succ msd)) 0 str !i m);
-         str
+         Bytes.unsafe_to_string str
      else
       let m = num_decimal_digits_int (succ msd)
       and p = n + 3 in
-      let str = String.make (succ (m + p)) '0' in
+      let str = Bytes.make (succ (m + p)) '0' in
         (String.blit (if sign_r = -1 then "-0." else "+0.") 0 str 0 3);
         (String.blit s 0 str 3 n);
-        String.set str p 'e';
+        Bytes.set str p 'e';
         (if m = 0
-          then String.set str (succ p) '0'
+          then Bytes.set str (succ p) '0'
           else (String.blit (string_of_int (succ msd)) 0 str (succ p) m));
-        str
+        Bytes.unsafe_to_string str
 
 (* String approximation of a rational with a fixed number of significant *)
 (* digits printed                                                        *)
diff --git a/otherlibs/str/.depend b/otherlibs/str/.depend
index b0ff35895b..5be8377c2d 100644
--- a/otherlibs/str/.depend
+++ b/otherlibs/str/.depend
@@ -1,9 +1,9 @@
 strstubs.o: strstubs.c ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \
- ../../byterun/memory.h ../../byterun/gc.h ../../byterun/major_gc.h \
- ../../byterun/freelist.h ../../byterun/minor_gc.h ../../byterun/fail.h
+  ../../byterun/compatibility.h ../../byterun/config.h \
+  ../../byterun/../config/m.h ../../byterun/../config/s.h \
+  ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \
+  ../../byterun/memory.h ../../byterun/gc.h ../../byterun/major_gc.h \
+  ../../byterun/freelist.h ../../byterun/minor_gc.h ../../byterun/fail.h
 str.cmi :
 str.cmo : str.cmi
 str.cmx : str.cmi
diff --git a/otherlibs/str/str.ml b/otherlibs/str/str.ml
index b9b8c1536d..ffaea89ba4 100644
--- a/otherlibs/str/str.ml
+++ b/otherlibs/str/str.ml
@@ -25,16 +25,18 @@ let last_chars s n = String.sub s (String.length s - n) n
 
 module Charset =
   struct
-    type t = string (* of length 32 *)
+    type t = bytes (* of length 32 *)
 
-    (*let empty = String.make 32 '\000'*)
-    let full = String.make 32 '\255'
+    (*let empty = Bytes.make 32 '\000'*)
+    let full = Bytes.make 32 '\255'
 
-    let make_empty () = String.make 32 '\000'
+    let make_empty () = Bytes.make 32 '\000'
 
     let add s c =
       let i = Char.code c in
-      s.[i lsr 3] <- Char.chr(Char.code s.[i lsr 3] lor (1 lsl (i land 7)))
+      Bytes.set s (i lsr 3)
+                (Char.chr (Char.code (Bytes.get s (i lsr 3))
+                           lor (1 lsl (i land 7))))
 
     let add_range s c1 c2 =
       for i = Char.code c1 to Char.code c2 do add s (Char.chr i) done
@@ -46,23 +48,26 @@ module Charset =
       let s = make_empty () in add_range s c1 c2; s
     *)
     let complement s =
-      let r = String.create 32 in
+      let r = Bytes.create 32 in
       for i = 0 to 31 do
-        r.[i] <- Char.chr(Char.code s.[i] lxor 0xFF)
+        Bytes.set r i (Char.chr(Char.code (Bytes.get s i) lxor 0xFF))
       done;
       r
 
     let union s1 s2 =
-      let r = String.create 32 in
+      let r = Bytes.create 32 in
       for i = 0 to 31 do
-        r.[i] <- Char.chr(Char.code s1.[i] lor Char.code s2.[i])
+        Bytes.set r i (Char.chr(Char.code (Bytes.get s1 i)
+                       lor Char.code (Bytes.get s2 i)))
       done;
       r
 
     let disjoint s1 s2 =
       try
         for i = 0 to 31 do
-          if Char.code s1.[i] land Char.code s2.[i] <> 0 then raise Exit
+          if Char.code (Bytes.get s1 i) land Char.code (Bytes.get s2 i)
+             <> 0
+          then raise Exit
         done;
         true
       with Exit ->
@@ -70,7 +75,7 @@ module Charset =
 
     let iter fn s =
       for i = 0 to 31 do
-        let c = Char.code s.[i] in
+        let c = Char.code (Bytes.get s i) in
         if c <> 0 then
           for j = 0 to 7 do
             if c land (1 lsl j) <> 0 then fn (Char.chr ((i lsl 3) + j))
@@ -78,8 +83,8 @@ module Charset =
       done
 
     let expand s =
-      let r = String.make 256 '\000' in
-      iter (fun c -> r.[Char.code c] <- '\001') s;
+      let r = Bytes.make 256 '\000' in
+      iter (fun c -> Bytes.set r (Char.code c) '\001') s;
       r
 
     let fold_case s =
@@ -201,14 +206,14 @@ let charclass_of_regexp fold_case re =
     | CharClass(cl, compl) -> (cl, compl)
     | _ -> assert false in
   let cl2 = if fold_case then Charset.fold_case cl1 else cl1 in
-  if compl then Charset.complement cl2 else cl2
+  Bytes.to_string (if compl then Charset.complement cl2 else cl2)
 
 (* The case fold table: maps characters to their lowercase equivalent *)
 
 let fold_case_table =
-  let t = String.create 256 in
-  for i = 0 to 255 do t.[i] <- Char.lowercase(Char.chr i) done;
-  t
+  let t = Bytes.create 256 in
+  for i = 0 to 255 do Bytes.set t i (Char.lowercase(Char.chr i)) done;
+  Bytes.to_string t
 
 module StringMap =
   Map.Make(struct type t = string let compare (x:t) y = compare x y end)
@@ -292,7 +297,7 @@ let compile fold_case re =
   | CharClass(cl, compl) ->
       let cl1 = if fold_case then Charset.fold_case cl else cl in
       let cl2 = if compl then Charset.complement cl1 else cl1 in
-      emit_instr op_CHARCLASS (cpool_index cl2)
+      emit_instr op_CHARCLASS (cpool_index (Bytes.to_string cl2))
   | Seq rl ->
       emit_seq_code rl
   | Alt(r1, r2) ->
@@ -412,7 +417,7 @@ let compile fold_case re =
   let start_pos =
     if start = Charset.full
     then -1
-    else cpool_index (Charset.expand start') in
+    else cpool_index (Bytes.to_string (Charset.expand start')) in
   let constantpool = Array.make !cpoolpos "" in
   StringMap.iter (fun str idx -> constantpool.(idx) <- str) !cpool;
   { prog = Array.sub !prog 0 !progpos;
@@ -553,16 +558,19 @@ let regexp_case_fold e = compile true (parse e)
 
 let quote s =
   let len = String.length s in
-  let buf = String.create (2 * len) in
+  let buf = Bytes.create (2 * len) in
   let pos = ref 0 in
   for i = 0 to len - 1 do
     match s.[i] with
       '[' | ']' | '*' | '.' | '\\' | '?' | '+' | '^' | '$' as c ->
-        buf.[!pos] <- '\\'; buf.[!pos + 1] <- c; pos := !pos + 2
+        Bytes.set buf !pos '\\';
+        Bytes.set buf (!pos + 1) c;
+        pos := !pos + 2
     | c ->
-        buf.[!pos] <- c; pos := !pos + 1
+        Bytes.set buf !pos c;
+        pos := !pos + 1
   done;
-  String.sub buf 0 !pos
+  Bytes.sub_string buf 0 !pos
 
 let regexp_string s = compile false (String s)
 
diff --git a/otherlibs/systhreads/.depend b/otherlibs/systhreads/.depend
index 93b01d6876..85add2e592 100644
--- a/otherlibs/systhreads/.depend
+++ b/otherlibs/systhreads/.depend
@@ -1,14 +1,14 @@
 st_stubs.o: st_stubs.c ../../byterun/alloc.h \
- ../../byterun/compatibility.h ../../byterun/misc.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/mlvalues.h \
- ../../byterun/backtrace.h ../../byterun/callback.h \
- ../../byterun/custom.h ../../byterun/fail.h ../../byterun/io.h \
- ../../byterun/memory.h ../../byterun/gc.h ../../byterun/major_gc.h \
- ../../byterun/freelist.h ../../byterun/minor_gc.h ../../byterun/misc.h \
- ../../byterun/mlvalues.h ../../byterun/printexc.h ../../byterun/roots.h \
- ../../byterun/memory.h ../../byterun/signals.h ../../byterun/stacks.h \
- ../../byterun/sys.h threads.h st_posix.h
+  ../../byterun/compatibility.h ../../byterun/misc.h \
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/mlvalues.h \
+  ../../byterun/backtrace.h ../../byterun/callback.h \
+  ../../byterun/custom.h ../../byterun/fail.h ../../byterun/io.h \
+  ../../byterun/memory.h ../../byterun/gc.h ../../byterun/major_gc.h \
+  ../../byterun/freelist.h ../../byterun/minor_gc.h ../../byterun/misc.h \
+  ../../byterun/mlvalues.h ../../byterun/printexc.h ../../byterun/roots.h \
+  ../../byterun/memory.h ../../byterun/signals.h ../../byterun/stacks.h \
+  ../../byterun/sys.h threads.h st_posix.h
 condition.cmi : mutex.cmi
 event.cmi :
 mutex.cmi :
diff --git a/otherlibs/systhreads/Makefile b/otherlibs/systhreads/Makefile
index a34bd4b879..a08bf34b43 100644
--- a/otherlibs/systhreads/Makefile
+++ b/otherlibs/systhreads/Makefile
@@ -19,7 +19,7 @@ CAMLC=$(ROOTDIR)/boot/ocamlrun $(ROOTDIR)/ocamlc -nostdlib \
 CAMLOPT=$(ROOTDIR)/boot/ocamlrun $(ROOTDIR)/ocamlopt -nostdlib \
         -I $(ROOTDIR)/stdlib -I $(ROOTDIR)/otherlibs/unix
 MKLIB=../../boot/ocamlrun ../../tools/ocamlmklib
-COMPFLAGS=-w +33..39 -warn-error A -g -bin-annot
+COMPFLAGS=-w +33..39 -warn-error A -g -bin-annot -safe-string
 
 BYTECODE_C_OBJS=st_stubs_b.o
 NATIVECODE_C_OBJS=st_stubs_n.o
diff --git a/otherlibs/systhreads/threadUnix.ml b/otherlibs/systhreads/threadUnix.ml
index 335afcb09e..c18f75bb47 100644
--- a/otherlibs/systhreads/threadUnix.ml
+++ b/otherlibs/systhreads/threadUnix.ml
@@ -26,6 +26,7 @@ let waitpid = Unix.waitpid
 let system = Unix.system
 let read = Unix.read
 let write = Unix.write
+let write_substring = Unix.write_substring
 let select = Unix.select
 
 let timed_read fd buff ofs len timeout =
@@ -38,6 +39,9 @@ let timed_write fd buff ofs len timeout =
   then Unix.write fd buff ofs len
   else raise (Unix_error(ETIMEDOUT, "timed_write", ""))
 
+let timed_write_substring fd buff ofs len timeout =
+  timed_write fd (Bytes.unsafe_of_string buff) ofs len timeout
+
 let pipe = Unix.pipe
 
 let open_process_in = Unix.open_process_in
@@ -52,6 +56,8 @@ external connect : file_descr -> sockaddr -> unit = "unix_connect"
 let recv = Unix.recv
 let recvfrom = Unix.recvfrom
 let send = Unix.send
+let send_substring = Unix.send_substring
 let sendto = Unix.sendto
+let sendto_substring = Unix.sendto_substring
 
 let open_connection = Unix.open_connection
diff --git a/otherlibs/systhreads/threadUnix.mli b/otherlibs/systhreads/threadUnix.mli
index 63d27335f5..cac796b925 100644
--- a/otherlibs/systhreads/threadUnix.mli
+++ b/otherlibs/systhreads/threadUnix.mli
@@ -30,24 +30,29 @@ val system : string -> Unix.process_status
 
 (** {6 Basic input/output} *)
 
-val read : Unix.file_descr -> string -> int -> int -> int
-val write : Unix.file_descr -> string -> int -> int -> int
+val read : Unix.file_descr -> bytes -> int -> int -> int
+val write : Unix.file_descr -> bytes -> int -> int -> int
+val write_substring : Unix.file_descr -> string -> int -> int -> int
 
 (** {6 Input/output with timeout} *)
 
 val timed_read :
       Unix.file_descr ->
-      string -> int -> int -> float -> int
+      bytes -> int -> int -> float -> int
 (** See {!ThreadUnix.timed_write}. *)
 
 val timed_write :
       Unix.file_descr ->
-      string -> int -> int -> float -> int
+      bytes -> int -> int -> float -> int
 (** Behave as {!ThreadUnix.read} and {!ThreadUnix.write}, except that
    [Unix_error(ETIMEDOUT,_,_)] is raised if no data is
    available for reading or ready for writing after [d] seconds.
    The delay [d] is given in the fifth argument, in seconds. *)
 
+val timed_write_substring :
+      Unix.file_descr -> string -> int -> int -> float -> int
+(** See {!ThreadUnix.timed_write}. *)
+
 (** {6 Polling} *)
 
 val select :
@@ -72,12 +77,16 @@ val socket : Unix.socket_domain ->
              Unix.socket_type -> int -> Unix.file_descr
 val accept : Unix.file_descr -> Unix.file_descr * Unix.sockaddr
 val connect : Unix.file_descr -> Unix.sockaddr -> unit
-val recv : Unix.file_descr -> string ->
+val recv : Unix.file_descr -> bytes ->
            int -> int -> Unix.msg_flag list -> int
-val recvfrom : Unix.file_descr -> string -> int -> int ->
+val recvfrom : Unix.file_descr -> bytes -> int -> int ->
                Unix.msg_flag list -> int * Unix.sockaddr
-val send : Unix.file_descr -> string -> int -> int ->
+val send : Unix.file_descr -> bytes -> int -> int ->
            Unix.msg_flag list -> int
-val sendto : Unix.file_descr -> string -> int -> int ->
+val send_substring : Unix.file_descr -> string -> int -> int ->
+           Unix.msg_flag list -> int
+val sendto : Unix.file_descr -> bytes -> int -> int ->
+             Unix.msg_flag list -> Unix.sockaddr -> int
+val sendto_substring : Unix.file_descr -> string -> int -> int ->
              Unix.msg_flag list -> Unix.sockaddr -> int
 val open_connection : Unix.sockaddr -> in_channel * out_channel
diff --git a/otherlibs/threads/.depend b/otherlibs/threads/.depend
index 091feb6394..bc03050be3 100644
--- a/otherlibs/threads/.depend
+++ b/otherlibs/threads/.depend
@@ -1,14 +1,14 @@
 scheduler.o: scheduler.c ../../byterun/alloc.h \
- ../../byterun/compatibility.h ../../byterun/misc.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/mlvalues.h \
- ../../byterun/backtrace.h ../../byterun/callback.h \
- ../../byterun/config.h ../../byterun/fail.h ../../byterun/io.h \
- ../../byterun/memory.h ../../byterun/gc.h ../../byterun/major_gc.h \
- ../../byterun/freelist.h ../../byterun/minor_gc.h ../../byterun/misc.h \
- ../../byterun/mlvalues.h ../../byterun/printexc.h ../../byterun/roots.h \
- ../../byterun/memory.h ../../byterun/signals.h ../../byterun/stacks.h \
- ../../byterun/sys.h
+  ../../byterun/compatibility.h ../../byterun/misc.h \
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/mlvalues.h \
+  ../../byterun/backtrace.h ../../byterun/callback.h \
+  ../../byterun/config.h ../../byterun/fail.h ../../byterun/io.h \
+  ../../byterun/memory.h ../../byterun/gc.h ../../byterun/major_gc.h \
+  ../../byterun/freelist.h ../../byterun/minor_gc.h ../../byterun/misc.h \
+  ../../byterun/mlvalues.h ../../byterun/printexc.h ../../byterun/roots.h \
+  ../../byterun/memory.h ../../byterun/signals.h ../../byterun/stacks.h \
+  ../../byterun/sys.h
 condition.cmi : mutex.cmi
 event.cmi :
 marshal.cmi :
diff --git a/otherlibs/threads/Makefile b/otherlibs/threads/Makefile
index 5c4be281da..1c4434f5b3 100644
--- a/otherlibs/threads/Makefile
+++ b/otherlibs/threads/Makefile
@@ -19,7 +19,7 @@ ROOTDIR=../..
 CAMLC=$(ROOTDIR)/boot/ocamlrun $(ROOTDIR)/ocamlc -nostdlib \
       -I $(ROOTDIR)/stdlib -I $(ROOTDIR)/otherlibs/unix
 MKLIB=../../boot/ocamlrun ../../tools/ocamlmklib
-COMPFLAGS=-w +33..39 -warn-error A -bin-annot
+COMPFLAGS=-w +33..39 -warn-error A -bin-annot -safe-string
 
 C_OBJS=scheduler.o
 
@@ -27,7 +27,7 @@ CAML_OBJS=thread.cmo mutex.cmo condition.cmo event.cmo threadUnix.cmo
 
 LIB=../../stdlib
 
-LIB_OBJS=pervasives.cmo \
+LIB_OBJS=$(LIB)/camlinternalFormatBasics.cmo pervasives.cmo \
   $(LIB)/array.cmo $(LIB)/list.cmo $(LIB)/char.cmo $(LIB)/string.cmo        \
   $(LIB)/sys.cmo $(LIB)/sort.cmo marshal.cmo $(LIB)/obj.cmo                 \
   $(LIB)/int32.cmo $(LIB)/int64.cmo $(LIB)/nativeint.cmo                    \
diff --git a/otherlibs/threads/marshal.ml b/otherlibs/threads/marshal.ml
index c71ca83d08..005e964372 100644
--- a/otherlibs/threads/marshal.ml
+++ b/otherlibs/threads/marshal.ml
@@ -16,6 +16,9 @@ type extern_flags =
   | Closures
   | Compat_32
 
+external to_bytes: 'a -> extern_flags list -> bytes
+    = "caml_output_value_to_string"
+
 external to_string: 'a -> extern_flags list -> string
     = "caml_output_value_to_string"
 
@@ -23,35 +26,34 @@ let to_channel chan v flags =
   output_string chan (to_string v flags)
 
 external to_buffer_unsafe:
-      string -> int -> int -> 'a -> extern_flags list -> int
+      bytes -> int -> int -> 'a -> extern_flags list -> int
     = "caml_output_value_to_buffer"
 
 let to_buffer buff ofs len v flags =
-  if ofs < 0 || len < 0 || ofs + len > String.length buff
+  if ofs < 0 || len < 0 || ofs + len > Bytes.length buff
   then invalid_arg "Marshal.to_buffer: substring out of bounds"
   else to_buffer_unsafe buff ofs len v flags
 
-let to_buffer' ~buf ~pos ~len v ~mode = to_buffer buf pos len v mode
-
-external from_string_unsafe: string -> int -> 'a
+external from_channel: in_channel -> 'a = "caml_input_value"
+external from_bytes_unsafe: bytes -> int -> 'a
          = "caml_input_value_from_string"
-external data_size_unsafe: string -> int -> int = "caml_marshal_data_size"
+external data_size_unsafe: bytes -> int -> int = "caml_marshal_data_size"
 
 let header_size = 20
 let data_size buff ofs =
-  if ofs < 0 || ofs > String.length buff - header_size
+  if ofs < 0 || ofs > Bytes.length buff - header_size
   then invalid_arg "Marshal.data_size"
   else data_size_unsafe buff ofs
 let total_size buff ofs = header_size + data_size buff ofs
 
-let from_string buff ofs =
-  if ofs < 0 || ofs > String.length buff - header_size
-  then invalid_arg "Marshal.from_size"
+let from_bytes buff ofs =
+  if ofs < 0 || ofs > Bytes.length buff - header_size
+  then invalid_arg "Marshal.from_bytes"
   else begin
     let len = data_size_unsafe buff ofs in
-    if ofs > String.length buff - (header_size + len)
-    then invalid_arg "Marshal.from_string"
-    else from_string_unsafe buff ofs
+    if ofs > Bytes.length buff - (header_size + len)
+    then invalid_arg "Marshal.from_bytes"
+    else from_bytes_unsafe buff ofs
   end
 
-let from_channel = Pervasives.input_value
+let from_string buff ofs = from_bytes (Bytes.unsafe_of_string buff) ofs
diff --git a/otherlibs/threads/pervasives.ml b/otherlibs/threads/pervasives.ml
index ef7432b875..e6f1cc16b9 100644
--- a/otherlibs/threads/pervasives.ml
+++ b/otherlibs/threads/pervasives.ml
@@ -50,9 +50,7 @@ external __MODULE__ : string = "%loc_MODULE"
 external __POS__ : string * int * int * int = "%loc_POS"
 
 external __LOC_OF__ : 'a -> string * 'a = "%loc_LOC"
-external __FILE_OF__ : 'a -> string * 'a = "%loc_FILE"
 external __LINE_OF__ : 'a -> int * 'a = "%loc_LINE"
-external __MODULE_OF__ : 'a -> string * 'a = "%loc_MODULE"
 external __POS_OF__ : 'a -> (string * int * int * int) * 'a = "%loc_POS"
 
 (* Comparisons *)
@@ -87,7 +85,7 @@ external succ : int -> int = "%succint"
 external pred : int -> int = "%predint"
 external ( + ) : int -> int -> int = "%addint"
 external ( - ) : int -> int -> int = "%subint"
-external ( *  ) : int -> int -> int = "%mulint"
+external ( * ) : int -> int -> int = "%mulint"
 external ( / ) : int -> int -> int = "%divint"
 external ( mod ) : int -> int -> int = "%modint"
 
@@ -168,19 +166,24 @@ type fpclass =
   | FP_nan
 external classify_float : float -> fpclass = "caml_classify_float"
 
-(* String operations -- more in module String *)
+(* String and byte sequence operations -- more in modules String and Bytes *)
 
 external string_length : string -> int = "%string_length"
-external string_create : int -> string = "caml_create_string"
-external string_blit : string -> int -> string -> int -> int -> unit
+external bytes_length : bytes -> int = "%string_length"
+external bytes_create : int -> bytes = "caml_create_string"
+external string_blit : string -> int -> bytes -> int -> int -> unit
                      = "caml_blit_string" "noalloc"
+external bytes_blit : bytes -> int -> bytes -> int -> int -> unit
+                        = "caml_blit_string" "noalloc"
+external bytes_unsafe_to_string : bytes -> string = "%identity"
+external bytes_unsafe_of_string : string -> bytes = "%identity"
 
 let ( ^ ) s1 s2 =
   let l1 = string_length s1 and l2 = string_length s2 in
-  let s = string_create (l1 + l2) in
+  let s = bytes_create (l1 + l2) in
   string_blit s1 0 s 0 l1;
   string_blit s2 0 s l1 l2;
-  s
+  bytes_unsafe_to_string s
 
 (* Character operations -- more in module Char *)
 
@@ -223,12 +226,13 @@ let string_of_int n =
   format_int "%d" n
 
 external int_of_string : string -> int = "caml_int_of_string"
+external string_get : string -> int -> char = "%string_safe_get"
 
 let valid_float_lexem s =
   let l = string_length s in
   let rec loop i =
     if i >= l then s ^ "." else
-    match s.[i] with
+    match string_get s i with
     | '0' .. '9' | '-' -> loop (i + 1)
     | _ -> s
   in
@@ -319,7 +323,7 @@ let flush_all () =
         iter l
   in iter (out_channels_list ())
 
-external unsafe_output_partial : out_channel -> string -> int -> int -> int
+external unsafe_output_partial : out_channel -> bytes -> int -> int -> int
                         = "caml_ml_output_partial"
 
 let rec unsafe_output oc buf pos len =
@@ -343,15 +347,19 @@ let rec output_char oc c =
   with Sys_blocked_io ->
     wait_outchan oc 1; output_char oc c
 
+let output_bytes oc s =
+  unsafe_output oc s 0 (bytes_length s)
+
 let output_string oc s =
-  unsafe_output oc s 0 (string_length s)
+  unsafe_output oc (bytes_unsafe_of_string s) 0 (string_length s)
 
 let output oc s ofs len =
-  if ofs < 0 || len < 0 || ofs > string_length s - len
+  if ofs < 0 || len < 0 || ofs > bytes_length s - len
   then invalid_arg "output"
   else unsafe_output oc s ofs len
 
-let output' oc ~buf ~pos ~len = output oc buf pos len
+let output_substring oc s ofs len =
+  output oc (bytes_unsafe_of_string s) ofs len
 
 let rec output_byte oc b =
   try
@@ -405,7 +413,7 @@ let rec input_char ic =
   with Sys_blocked_io ->
     wait_inchan ic; input_char ic
 
-external unsafe_input_blocking : in_channel -> string -> int -> int -> int
+external unsafe_input_blocking : in_channel -> bytes -> int -> int -> int
                                = "caml_ml_input"
 
 let rec unsafe_input ic s ofs len =
@@ -415,7 +423,7 @@ let rec unsafe_input ic s ofs len =
     wait_inchan ic; unsafe_input ic s ofs len
 
 let input ic s ofs len =
-  if ofs < 0 || len < 0 || ofs > string_length s - len
+  if ofs < 0 || len < 0 || ofs > bytes_length s - len
   then invalid_arg "input"
   else unsafe_input ic s ofs len
 
@@ -428,31 +436,38 @@ let rec unsafe_really_input ic s ofs len =
   end
 
 let really_input ic s ofs len =
-  if ofs < 0 || len < 0 || ofs > string_length s - len
+  if ofs < 0 || len < 0 || ofs > bytes_length s - len
   then invalid_arg "really_input"
   else unsafe_really_input ic s ofs len
 
+let really_input_string ic len =
+  let s = bytes_create len in
+  really_input ic s 0 len;
+  bytes_unsafe_to_string s
+
+external bytes_set : bytes -> int -> char -> unit = "%string_safe_set"
+
 let input_line ic =
-  let buf = ref (string_create 128) in
+  let buf = ref (bytes_create 128) in
   let pos = ref 0 in
   begin try
     while true do
-      if !pos = string_length !buf then begin
-        let newbuf = string_create (2 * !pos) in
-        string_blit !buf 0 newbuf 0 !pos;
+      if !pos = bytes_length !buf then begin
+        let newbuf = bytes_create (2 * !pos) in
+        bytes_blit !buf 0 newbuf 0 !pos;
         buf := newbuf
       end;
       let c = input_char ic in
       if c = '\n' then raise Exit;
-      !buf.[!pos] <- c;
+      bytes_set !buf !pos c;
       incr pos
     done
   with Exit -> ()
      | End_of_file -> if !pos = 0 then raise End_of_file
   end;
-  let res = string_create !pos in
-  string_blit !buf 0 res 0 !pos;
-  res
+  let res = bytes_create !pos in
+  bytes_blit !buf 0 res 0 !pos;
+  bytes_unsafe_to_string res
 
 let rec input_byte ic =
   try
@@ -468,15 +483,15 @@ let input_binary_int ic =
   let b4 = input_byte ic in
   (n1 lsl 24) + (b2 lsl 16) + (b3 lsl 8) + b4
 
-external unmarshal : string -> int -> 'a = "caml_input_value_from_string"
-external marshal_data_size : string -> int -> int = "caml_marshal_data_size"
+external unmarshal : bytes -> int -> 'a = "caml_input_value_from_string"
+external marshal_data_size : bytes -> int -> int = "caml_marshal_data_size"
 
 let input_value ic =
-  let header = string_create 20 in
+  let header = bytes_create 20 in
   really_input ic header 0 20;
   let bsize = marshal_data_size header 0 in
-  let buffer = string_create (20 + bsize) in
-  string_blit header 0 buffer 0 20;
+  let buffer = bytes_create (20 + bsize) in
+  bytes_blit header 0 buffer 0 20;
   really_input ic buffer 20 bsize;
   unmarshal buffer 0
 
@@ -492,6 +507,7 @@ external set_binary_mode_in : in_channel -> bool -> unit
 
 let print_char c = output_char stdout c
 let print_string s = output_string stdout s
+let print_bytes s = output_bytes stdout s
 let print_int i = output_string stdout (string_of_int i)
 let print_float f = output_string stdout (string_of_float f)
 let print_endline s =
@@ -502,6 +518,7 @@ let print_newline () = output_char stdout '\n'; flush stdout
 
 let prerr_char c = output_char stderr c
 let prerr_string s = output_string stderr s
+let prerr_bytes s = output_bytes stderr s
 let prerr_int i = output_string stderr (string_of_int i)
 let prerr_float f = output_string stderr (string_of_float f)
 let prerr_endline s =
@@ -528,33 +545,25 @@ module LargeFile =
   end
 
 (* Formats *)
+
+type ('a, 'b, 'c, 'd, 'e, 'f) format6
+   = ('a, 'b, 'c, 'd, 'e, 'f) CamlinternalFormatBasics.format6
+   = Format of ('a, 'b, 'c, 'd, 'e, 'f) CamlinternalFormatBasics.fmt
+               * string
+
 type ('a, 'b, 'c, 'd) format4 = ('a, 'b, 'c, 'c, 'c, 'd) format6
 
 type ('a, 'b, 'c) format = ('a, 'b, 'c, 'c) format4
 
+let string_of_format (Format (fmt, str)) = str
+
 external format_of_string :
  ('a, 'b, 'c, 'd, 'e, 'f) format6 ->
  ('a, 'b, 'c, 'd, 'e, 'f) format6 = "%identity"
 
-external format_to_string :
- ('a, 'b, 'c, 'd, 'e, 'f) format6 -> string = "%identity"
-external string_to_format :
- string -> ('a, 'b, 'c, 'd, 'e, 'f) format6 = "%identity"
-
-let (( ^^ ) :
-      ('a, 'b, 'c, 'd, 'e, 'f) format6 ->
-      ('f, 'b, 'c, 'e, 'g, 'h) format6 ->
-      ('a, 'b, 'c, 'd, 'g, 'h) format6) =
-  fun fmt1 fmt2 ->
-    string_to_format (format_to_string fmt1 ^ "%," ^ format_to_string fmt2)
-;;
-
-let string_of_format fmt =
-  let s = format_to_string fmt in
-  let l = string_length s in
-  let r = string_create l in
-  string_blit s 0 r 0 l;
-  r
+let (^^) (Format (fmt1, str1)) (Format (fmt2, str2)) =
+  Format (CamlinternalFormatBasics.concat_fmt fmt1 fmt2,
+          str1 ^ "%," ^ str2)
 
 (* Miscellaneous *)
 
diff --git a/otherlibs/threads/threadUnix.ml b/otherlibs/threads/threadUnix.ml
index fe5ef4fdfc..c086c1f55f 100644
--- a/otherlibs/threads/threadUnix.ml
+++ b/otherlibs/threads/threadUnix.ml
@@ -22,6 +22,8 @@ let system = Unix.system
 let read = Unix.read
 let write = Unix.write
 let single_write = Unix.single_write
+let write_substring = Unix.write_substring
+let single_write_substring = Unix.single_write_substring
 let select = Unix.select
 let pipe = Unix.pipe
 let open_process_in = Unix.open_process_in
@@ -36,7 +38,9 @@ let connect = Unix.connect
 let recv = Unix.recv
 let recvfrom = Unix.recvfrom
 let send = Unix.send
+let send_substring = Unix.send_substring
 let sendto = Unix.sendto
+let sendto_substring = Unix.sendto_substring
 let open_connection = Unix.open_connection
 let establish_server = Unix.establish_server
 
@@ -57,3 +61,6 @@ let rec timed_write fd buff ofs len timeout =
                     timed_write fd buff ofs len timeout
        end
   else raise (Unix_error(ETIMEDOUT, "timed_write", ""))
+
+let timed_write_substring fd buff ofs len timeout =
+  timed_write fd (Bytes.unsafe_of_string buff) ofs len timeout
diff --git a/otherlibs/threads/threadUnix.mli b/otherlibs/threads/threadUnix.mli
index 4ebe28f4f2..52862f98a1 100644
--- a/otherlibs/threads/threadUnix.mli
+++ b/otherlibs/threads/threadUnix.mli
@@ -30,21 +30,27 @@ val system : string -> Unix.process_status
 
 (** {6 Basic input/output} *)
 
-val read : Unix.file_descr -> string -> int -> int -> int
-val write : Unix.file_descr -> string -> int -> int -> int
-val single_write : Unix.file_descr -> string -> int -> int -> int
+val read : Unix.file_descr -> bytes -> int -> int -> int
+val write : Unix.file_descr -> bytes -> int -> int -> int
+val single_write : Unix.file_descr -> bytes -> int -> int -> int
+val write_substring : Unix.file_descr -> string -> int -> int -> int
+val single_write_substring : Unix.file_descr -> string -> int -> int -> int
 
 (** {6 Input/output with timeout} *)
 
-val timed_read : Unix.file_descr -> string -> int -> int -> float -> int
+val timed_read : Unix.file_descr -> bytes -> int -> int -> float -> int
 (** See {!ThreadUnix.timed_write}. *)
 
-val timed_write : Unix.file_descr -> string -> int -> int -> float -> int
+val timed_write : Unix.file_descr -> bytes -> int -> int -> float -> int
 (** Behave as {!ThreadUnix.read} and {!ThreadUnix.write}, except that
    [Unix_error(ETIMEDOUT,_,_)] is raised if no data is
    available for reading or ready for writing after [d] seconds.
    The delay [d] is given in the fifth argument, in seconds. *)
 
+val timed_write_substring :
+      Unix.file_descr -> string -> int -> int -> float -> int
+(** See {!ThreadUnix.timed_write}. *)
+
 (** {6 Polling} *)
 
 val select :
@@ -74,13 +80,18 @@ val socketpair :
 val accept : Unix.file_descr -> Unix.file_descr * Unix.sockaddr
 val connect : Unix.file_descr -> Unix.sockaddr -> unit
 val recv :
-  Unix.file_descr -> string -> int -> int -> Unix.msg_flag list -> int
+  Unix.file_descr -> bytes -> int -> int -> Unix.msg_flag list -> int
 val recvfrom :
-  Unix.file_descr -> string -> int -> int -> Unix.msg_flag list ->
+  Unix.file_descr -> bytes -> int -> int -> Unix.msg_flag list ->
     int * Unix.sockaddr
 val send :
+  Unix.file_descr -> bytes -> int -> int -> Unix.msg_flag list -> int
+val send_substring :
   Unix.file_descr -> string -> int -> int -> Unix.msg_flag list -> int
 val sendto :
+  Unix.file_descr -> bytes -> int -> int -> Unix.msg_flag list ->
+    Unix.sockaddr -> int
+val sendto_substring :
   Unix.file_descr -> string -> int -> int -> Unix.msg_flag list ->
     Unix.sockaddr -> int
 val open_connection : Unix.sockaddr -> in_channel * out_channel
diff --git a/otherlibs/threads/unix.ml b/otherlibs/threads/unix.ml
index 80ea7aed64..a397ec404f 100644
--- a/otherlibs/threads/unix.ml
+++ b/otherlibs/threads/unix.ml
@@ -205,15 +205,15 @@ external openfile : string -> open_flag list -> file_perm -> file_descr
            = "unix_open"
 
 external close : file_descr -> unit = "unix_close"
-external unsafe_read : file_descr -> string -> int -> int -> int = "unix_read"
-external unsafe_write : file_descr -> string -> int -> int -> int
+external unsafe_read : file_descr -> bytes -> int -> int -> int = "unix_read"
+external unsafe_write : file_descr -> bytes -> int -> int -> int
     = "unix_write"
-external unsafe_single_write : file_descr -> string -> int -> int -> int
+external unsafe_single_write : file_descr -> bytes -> int -> int -> int
     = "unix_single_write"
 
 let rec read fd buf ofs len =
   try
-    if ofs < 0 || len < 0 || ofs > String.length buf - len
+    if ofs < 0 || len < 0 || ofs > Bytes.length buf - len
     then invalid_arg "Unix.read"
     else unsafe_read fd buf ofs len
   with Unix_error((EAGAIN | EWOULDBLOCK), _, _) ->
@@ -221,7 +221,7 @@ let rec read fd buf ofs len =
 
 let rec write fd buf ofs len =
   try
-    if ofs < 0 || len < 0 || ofs > String.length buf - len
+    if ofs < 0 || len < 0 || ofs > Bytes.length buf - len
     then invalid_arg "Unix.write"
     else unsafe_write fd buf ofs len
   with Unix_error((EAGAIN | EWOULDBLOCK), _, _) ->
@@ -229,12 +229,18 @@ let rec write fd buf ofs len =
 
 let rec single_write fd buf ofs len =
   try
-    if ofs < 0 || len < 0 || ofs > String.length buf - len
-    then invalid_arg "Unix.partial_write"
+    if ofs < 0 || len < 0 || ofs > Bytes.length buf - len
+    then invalid_arg "Unix.single_write"
     else unsafe_single_write fd buf ofs len
   with Unix_error((EAGAIN | EWOULDBLOCK), _, _) ->
     wait_write fd; single_write fd buf ofs len
 
+let write_substring fd buf ofs len =
+  write fd (Bytes.unsafe_of_string buf) ofs len
+
+let single_write_substring fd buf ofs len =
+  single_write fd (Bytes.unsafe_of_string buf) ofs len
+
 external in_channel_of_descr : file_descr -> in_channel
                              = "caml_ml_open_descriptor_in"
 external out_channel_of_descr : file_descr -> out_channel
@@ -591,21 +597,21 @@ let connect s addr =
     ignore(getpeername s)
 
 external unsafe_recv :
-  file_descr -> string -> int -> int -> msg_flag list -> int
+  file_descr -> bytes -> int -> int -> msg_flag list -> int
                                   = "unix_recv"
 external unsafe_recvfrom :
-  file_descr -> string -> int -> int -> msg_flag list -> int * sockaddr
+  file_descr -> bytes -> int -> int -> msg_flag list -> int * sockaddr
                                   = "unix_recvfrom"
 external unsafe_send :
-  file_descr -> string -> int -> int -> msg_flag list -> int
+  file_descr -> bytes -> int -> int -> msg_flag list -> int
                                   = "unix_send"
 external unsafe_sendto :
-  file_descr -> string -> int -> int -> msg_flag list -> sockaddr -> int
+  file_descr -> bytes -> int -> int -> msg_flag list -> sockaddr -> int
                                   = "unix_sendto" "unix_sendto_native"
 
 let rec recv fd buf ofs len flags =
   try
-    if ofs < 0 || len < 0 || ofs > String.length buf - len
+    if ofs < 0 || len < 0 || ofs > Bytes.length buf - len
     then invalid_arg "Unix.recv"
     else unsafe_recv fd buf ofs len flags
   with Unix_error((EAGAIN | EWOULDBLOCK), _, _) ->
@@ -613,7 +619,7 @@ let rec recv fd buf ofs len flags =
 
 let rec recvfrom fd buf ofs len flags =
   try
-    if ofs < 0 || len < 0 || ofs > String.length buf - len
+    if ofs < 0 || len < 0 || ofs > Bytes.length buf - len
     then invalid_arg "Unix.recvfrom"
     else unsafe_recvfrom fd buf ofs len flags
   with Unix_error((EAGAIN | EWOULDBLOCK), _, _) ->
@@ -622,7 +628,7 @@ let rec recvfrom fd buf ofs len flags =
 
 let rec send fd buf ofs len flags =
   try
-    if ofs < 0 || len < 0 || ofs > String.length buf - len
+    if ofs < 0 || len < 0 || ofs > Bytes.length buf - len
     then invalid_arg "Unix.send"
     else unsafe_send fd buf ofs len flags
   with Unix_error((EAGAIN | EWOULDBLOCK), _, _) ->
@@ -631,13 +637,19 @@ let rec send fd buf ofs len flags =
 
 let rec sendto fd buf ofs len flags addr =
   try
-    if ofs < 0 || len < 0 || ofs > String.length buf - len
+    if ofs < 0 || len < 0 || ofs > Bytes.length buf - len
     then invalid_arg "Unix.sendto"
     else unsafe_sendto fd buf ofs len flags addr
   with Unix_error((EAGAIN | EWOULDBLOCK), _, _) ->
     wait_write fd;
     sendto fd buf ofs len flags addr
 
+let send_substring fd buf ofs len flags =
+  send fd (Bytes.unsafe_of_string buf) ofs len flags
+
+let sendto_substring fd buf ofs len flags addr =
+  sendto fd (Bytes.unsafe_of_string buf) ofs len flags addr
+
 type socket_bool_option =
     SO_DEBUG
   | SO_BROADCAST
diff --git a/otherlibs/unix/.depend b/otherlibs/unix/.depend
index f3f79821d1..63e1d22935 100644
--- a/otherlibs/unix/.depend
+++ b/otherlibs/unix/.depend
@@ -1,498 +1,502 @@
 accept.o: accept.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \
- ../../byterun/mlvalues.h ../../byterun/fail.h ../../byterun/memory.h \
- ../../byterun/gc.h ../../byterun/major_gc.h ../../byterun/freelist.h \
- ../../byterun/minor_gc.h ../../byterun/signals.h unixsupport.h \
- socketaddr.h ../../byterun/misc.h
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \
+  ../../byterun/mlvalues.h ../../byterun/fail.h ../../byterun/memory.h \
+  ../../byterun/gc.h ../../byterun/major_gc.h ../../byterun/freelist.h \
+  ../../byterun/minor_gc.h ../../byterun/signals.h unixsupport.h \
+  socketaddr.h ../../byterun/misc.h
 access.o: access.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \
- ../../byterun/mlvalues.h ../../byterun/memory.h ../../byterun/gc.h \
- ../../byterun/major_gc.h ../../byterun/freelist.h \
- ../../byterun/minor_gc.h ../../byterun/signals.h unixsupport.h
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \
+  ../../byterun/mlvalues.h ../../byterun/memory.h ../../byterun/gc.h \
+  ../../byterun/major_gc.h ../../byterun/freelist.h \
+  ../../byterun/minor_gc.h ../../byterun/signals.h unixsupport.h
 addrofstr.o: addrofstr.c ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../byterun/misc.h ../../byterun/memory.h ../../byterun/gc.h \
- ../../byterun/mlvalues.h ../../byterun/major_gc.h \
- ../../byterun/freelist.h ../../byterun/minor_gc.h ../../byterun/fail.h \
- unixsupport.h socketaddr.h ../../byterun/misc.h
+  ../../byterun/compatibility.h ../../byterun/config.h \
+  ../../byterun/../config/m.h ../../byterun/../config/s.h \
+  ../../byterun/misc.h ../../byterun/memory.h ../../byterun/gc.h \
+  ../../byterun/mlvalues.h ../../byterun/major_gc.h \
+  ../../byterun/freelist.h ../../byterun/minor_gc.h ../../byterun/fail.h \
+  unixsupport.h socketaddr.h ../../byterun/misc.h
 alarm.o: alarm.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h unixsupport.h
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/misc.h unixsupport.h
 bind.o: bind.c ../../byterun/fail.h ../../byterun/compatibility.h \
- ../../byterun/misc.h ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/mlvalues.h \
- ../../byterun/mlvalues.h unixsupport.h socketaddr.h ../../byterun/misc.h
+  ../../byterun/misc.h ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/mlvalues.h \
+  ../../byterun/mlvalues.h unixsupport.h socketaddr.h \
+  ../../byterun/misc.h
 chdir.o: chdir.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/memory.h \
- ../../byterun/gc.h ../../byterun/mlvalues.h ../../byterun/major_gc.h \
- ../../byterun/freelist.h ../../byterun/minor_gc.h \
- ../../byterun/signals.h unixsupport.h
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/memory.h \
+  ../../byterun/gc.h ../../byterun/mlvalues.h ../../byterun/major_gc.h \
+  ../../byterun/freelist.h ../../byterun/minor_gc.h \
+  ../../byterun/signals.h unixsupport.h
 chmod.o: chmod.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/memory.h \
- ../../byterun/gc.h ../../byterun/mlvalues.h ../../byterun/major_gc.h \
- ../../byterun/freelist.h ../../byterun/minor_gc.h \
- ../../byterun/signals.h unixsupport.h
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/memory.h \
+  ../../byterun/gc.h ../../byterun/mlvalues.h ../../byterun/major_gc.h \
+  ../../byterun/freelist.h ../../byterun/minor_gc.h \
+  ../../byterun/signals.h unixsupport.h
 chown.o: chown.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/memory.h \
- ../../byterun/gc.h ../../byterun/mlvalues.h ../../byterun/major_gc.h \
- ../../byterun/freelist.h ../../byterun/minor_gc.h \
- ../../byterun/signals.h unixsupport.h
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/memory.h \
+  ../../byterun/gc.h ../../byterun/mlvalues.h ../../byterun/major_gc.h \
+  ../../byterun/freelist.h ../../byterun/minor_gc.h \
+  ../../byterun/signals.h unixsupport.h
 chroot.o: chroot.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/memory.h \
- ../../byterun/gc.h ../../byterun/mlvalues.h ../../byterun/major_gc.h \
- ../../byterun/freelist.h ../../byterun/minor_gc.h \
- ../../byterun/signals.h unixsupport.h
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/memory.h \
+  ../../byterun/gc.h ../../byterun/mlvalues.h ../../byterun/major_gc.h \
+  ../../byterun/freelist.h ../../byterun/minor_gc.h \
+  ../../byterun/signals.h unixsupport.h
 close.o: close.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/signals.h \
- ../../byterun/mlvalues.h unixsupport.h
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/misc.h \
+  ../../byterun/signals.h ../../byterun/mlvalues.h unixsupport.h
 closedir.o: closedir.c ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../byterun/misc.h ../../byterun/memory.h ../../byterun/gc.h \
- ../../byterun/mlvalues.h ../../byterun/major_gc.h \
- ../../byterun/freelist.h ../../byterun/minor_gc.h \
- ../../byterun/signals.h unixsupport.h
+  ../../byterun/compatibility.h ../../byterun/config.h \
+  ../../byterun/../config/m.h ../../byterun/../config/s.h \
+  ../../byterun/misc.h ../../byterun/memory.h ../../byterun/gc.h \
+  ../../byterun/mlvalues.h ../../byterun/major_gc.h \
+  ../../byterun/freelist.h ../../byterun/minor_gc.h \
+  ../../byterun/signals.h unixsupport.h
 connect.o: connect.c ../../byterun/fail.h ../../byterun/compatibility.h \
- ../../byterun/misc.h ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/mlvalues.h \
- ../../byterun/mlvalues.h ../../byterun/signals.h unixsupport.h \
- socketaddr.h ../../byterun/misc.h
+  ../../byterun/misc.h ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/mlvalues.h \
+  ../../byterun/mlvalues.h ../../byterun/signals.h unixsupport.h \
+  socketaddr.h ../../byterun/misc.h
 cst2constr.o: cst2constr.c ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../byterun/misc.h ../../byterun/fail.h ../../byterun/mlvalues.h \
- cst2constr.h
+  ../../byterun/compatibility.h ../../byterun/config.h \
+  ../../byterun/../config/m.h ../../byterun/../config/s.h \
+  ../../byterun/misc.h ../../byterun/fail.h ../../byterun/mlvalues.h \
+  cst2constr.h
 cstringv.o: cstringv.c ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../byterun/misc.h ../../byterun/memory.h ../../byterun/gc.h \
- ../../byterun/mlvalues.h ../../byterun/major_gc.h \
- ../../byterun/freelist.h ../../byterun/minor_gc.h unixsupport.h
+  ../../byterun/compatibility.h ../../byterun/config.h \
+  ../../byterun/../config/m.h ../../byterun/../config/s.h \
+  ../../byterun/misc.h ../../byterun/memory.h ../../byterun/gc.h \
+  ../../byterun/mlvalues.h ../../byterun/major_gc.h \
+  ../../byterun/freelist.h ../../byterun/minor_gc.h unixsupport.h
 dup.o: dup.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h unixsupport.h
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/misc.h unixsupport.h
 dup2.o: dup2.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h unixsupport.h
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/misc.h unixsupport.h
 envir.o: envir.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \
- ../../byterun/mlvalues.h
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \
+  ../../byterun/mlvalues.h
 errmsg.o: errmsg.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \
- ../../byterun/mlvalues.h
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \
+  ../../byterun/mlvalues.h
 execv.o: execv.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/memory.h \
- ../../byterun/gc.h ../../byterun/mlvalues.h ../../byterun/major_gc.h \
- ../../byterun/freelist.h ../../byterun/minor_gc.h unixsupport.h
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/memory.h \
+  ../../byterun/gc.h ../../byterun/mlvalues.h ../../byterun/major_gc.h \
+  ../../byterun/freelist.h ../../byterun/minor_gc.h unixsupport.h
 execve.o: execve.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/memory.h \
- ../../byterun/gc.h ../../byterun/mlvalues.h ../../byterun/major_gc.h \
- ../../byterun/freelist.h ../../byterun/minor_gc.h unixsupport.h
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/memory.h \
+  ../../byterun/gc.h ../../byterun/mlvalues.h ../../byterun/major_gc.h \
+  ../../byterun/freelist.h ../../byterun/minor_gc.h unixsupport.h
 execvp.o: execvp.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/memory.h \
- ../../byterun/gc.h ../../byterun/mlvalues.h ../../byterun/major_gc.h \
- ../../byterun/freelist.h ../../byterun/minor_gc.h unixsupport.h
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/memory.h \
+  ../../byterun/gc.h ../../byterun/mlvalues.h ../../byterun/major_gc.h \
+  ../../byterun/freelist.h ../../byterun/minor_gc.h unixsupport.h
 exit.o: exit.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h unixsupport.h
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/misc.h unixsupport.h
 fchmod.o: fchmod.c ../../byterun/fail.h ../../byterun/compatibility.h \
- ../../byterun/misc.h ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/mlvalues.h \
- ../../byterun/mlvalues.h ../../byterun/signals.h unixsupport.h
+  ../../byterun/misc.h ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/mlvalues.h \
+  ../../byterun/mlvalues.h ../../byterun/signals.h unixsupport.h
 fchown.o: fchown.c ../../byterun/fail.h ../../byterun/compatibility.h \
- ../../byterun/misc.h ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/mlvalues.h \
- ../../byterun/mlvalues.h ../../byterun/signals.h unixsupport.h
+  ../../byterun/misc.h ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/mlvalues.h \
+  ../../byterun/mlvalues.h ../../byterun/signals.h unixsupport.h
 fcntl.o: fcntl.c ../../byterun/fail.h ../../byterun/compatibility.h \
- ../../byterun/misc.h ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/mlvalues.h \
- ../../byterun/mlvalues.h unixsupport.h
+  ../../byterun/misc.h ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/mlvalues.h \
+  ../../byterun/mlvalues.h unixsupport.h
 fork.o: fork.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h \
- ../../byterun/debugger.h ../../byterun/mlvalues.h unixsupport.h
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/misc.h \
+  ../../byterun/debugger.h ../../byterun/mlvalues.h unixsupport.h
 ftruncate.o: ftruncate.c ../../byterun/fail.h \
- ../../byterun/compatibility.h ../../byterun/misc.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/mlvalues.h \
- ../../byterun/mlvalues.h ../../byterun/io.h ../../byterun/signals.h \
- unixsupport.h
+  ../../byterun/compatibility.h ../../byterun/misc.h \
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/mlvalues.h \
+  ../../byterun/mlvalues.h ../../byterun/io.h ../../byterun/signals.h \
+  unixsupport.h
 getaddrinfo.o: getaddrinfo.c ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \
- ../../byterun/fail.h ../../byterun/memory.h ../../byterun/gc.h \
- ../../byterun/major_gc.h ../../byterun/freelist.h \
- ../../byterun/minor_gc.h ../../byterun/signals.h unixsupport.h \
- cst2constr.h socketaddr.h ../../byterun/misc.h
+  ../../byterun/compatibility.h ../../byterun/config.h \
+  ../../byterun/../config/m.h ../../byterun/../config/s.h \
+  ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \
+  ../../byterun/fail.h ../../byterun/memory.h ../../byterun/gc.h \
+  ../../byterun/major_gc.h ../../byterun/freelist.h \
+  ../../byterun/minor_gc.h ../../byterun/signals.h unixsupport.h \
+  cst2constr.h socketaddr.h ../../byterun/misc.h
 getcwd.o: getcwd.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \
- ../../byterun/mlvalues.h ../../byterun/fail.h unixsupport.h
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \
+  ../../byterun/mlvalues.h ../../byterun/fail.h unixsupport.h
 getegid.o: getegid.c ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../byterun/misc.h unixsupport.h
+  ../../byterun/compatibility.h ../../byterun/config.h \
+  ../../byterun/../config/m.h ../../byterun/../config/s.h \
+  ../../byterun/misc.h unixsupport.h
 geteuid.o: geteuid.c ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../byterun/misc.h unixsupport.h
+  ../../byterun/compatibility.h ../../byterun/config.h \
+  ../../byterun/../config/m.h ../../byterun/../config/s.h \
+  ../../byterun/misc.h unixsupport.h
 getgid.o: getgid.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h unixsupport.h
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/misc.h unixsupport.h
 getgr.o: getgr.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/fail.h \
- ../../byterun/mlvalues.h ../../byterun/alloc.h ../../byterun/memory.h \
- ../../byterun/gc.h ../../byterun/major_gc.h ../../byterun/freelist.h \
- ../../byterun/minor_gc.h unixsupport.h
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/fail.h \
+  ../../byterun/mlvalues.h ../../byterun/alloc.h ../../byterun/memory.h \
+  ../../byterun/gc.h ../../byterun/major_gc.h ../../byterun/freelist.h \
+  ../../byterun/minor_gc.h unixsupport.h
 getgroups.o: getgroups.c ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \
- ../../byterun/fail.h unixsupport.h
+  ../../byterun/compatibility.h ../../byterun/config.h \
+  ../../byterun/../config/m.h ../../byterun/../config/s.h \
+  ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \
+  ../../byterun/fail.h unixsupport.h
 gethost.o: gethost.c ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \
- ../../byterun/fail.h ../../byterun/memory.h ../../byterun/gc.h \
- ../../byterun/major_gc.h ../../byterun/freelist.h \
- ../../byterun/minor_gc.h ../../byterun/signals.h unixsupport.h \
- socketaddr.h ../../byterun/misc.h
+  ../../byterun/compatibility.h ../../byterun/config.h \
+  ../../byterun/../config/m.h ../../byterun/../config/s.h \
+  ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \
+  ../../byterun/fail.h ../../byterun/memory.h ../../byterun/gc.h \
+  ../../byterun/major_gc.h ../../byterun/freelist.h \
+  ../../byterun/minor_gc.h ../../byterun/signals.h unixsupport.h \
+  socketaddr.h ../../byterun/misc.h
 gethostname.o: gethostname.c ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \
- ../../byterun/fail.h unixsupport.h
+  ../../byterun/compatibility.h ../../byterun/config.h \
+  ../../byterun/../config/m.h ../../byterun/../config/s.h \
+  ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \
+  ../../byterun/fail.h unixsupport.h
 getlogin.o: getlogin.c ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \
- unixsupport.h
+  ../../byterun/compatibility.h ../../byterun/config.h \
+  ../../byterun/../config/m.h ../../byterun/../config/s.h \
+  ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \
+  unixsupport.h
 getnameinfo.o: getnameinfo.c ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \
- ../../byterun/fail.h ../../byterun/memory.h ../../byterun/gc.h \
- ../../byterun/major_gc.h ../../byterun/freelist.h \
- ../../byterun/minor_gc.h ../../byterun/signals.h unixsupport.h \
- socketaddr.h ../../byterun/misc.h
+  ../../byterun/compatibility.h ../../byterun/config.h \
+  ../../byterun/../config/m.h ../../byterun/../config/s.h \
+  ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \
+  ../../byterun/fail.h ../../byterun/memory.h ../../byterun/gc.h \
+  ../../byterun/major_gc.h ../../byterun/freelist.h \
+  ../../byterun/minor_gc.h ../../byterun/signals.h unixsupport.h \
+  socketaddr.h ../../byterun/misc.h
 getpeername.o: getpeername.c ../../byterun/fail.h \
- ../../byterun/compatibility.h ../../byterun/misc.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/mlvalues.h \
- ../../byterun/mlvalues.h unixsupport.h socketaddr.h ../../byterun/misc.h
+  ../../byterun/compatibility.h ../../byterun/misc.h \
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/mlvalues.h \
+  ../../byterun/mlvalues.h unixsupport.h socketaddr.h \
+  ../../byterun/misc.h
 getpid.o: getpid.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h unixsupport.h
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/misc.h unixsupport.h
 getppid.o: getppid.c ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../byterun/misc.h unixsupport.h
+  ../../byterun/compatibility.h ../../byterun/config.h \
+  ../../byterun/../config/m.h ../../byterun/../config/s.h \
+  ../../byterun/misc.h unixsupport.h
 getproto.o: getproto.c ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \
- ../../byterun/fail.h ../../byterun/memory.h ../../byterun/gc.h \
- ../../byterun/major_gc.h ../../byterun/freelist.h \
- ../../byterun/minor_gc.h unixsupport.h
+  ../../byterun/compatibility.h ../../byterun/config.h \
+  ../../byterun/../config/m.h ../../byterun/../config/s.h \
+  ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \
+  ../../byterun/fail.h ../../byterun/memory.h ../../byterun/gc.h \
+  ../../byterun/major_gc.h ../../byterun/freelist.h \
+  ../../byterun/minor_gc.h unixsupport.h
 getpw.o: getpw.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \
- ../../byterun/mlvalues.h ../../byterun/memory.h ../../byterun/gc.h \
- ../../byterun/major_gc.h ../../byterun/freelist.h \
- ../../byterun/minor_gc.h ../../byterun/fail.h unixsupport.h
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \
+  ../../byterun/mlvalues.h ../../byterun/memory.h ../../byterun/gc.h \
+  ../../byterun/major_gc.h ../../byterun/freelist.h \
+  ../../byterun/minor_gc.h ../../byterun/fail.h unixsupport.h
 getserv.o: getserv.c ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \
- ../../byterun/fail.h ../../byterun/memory.h ../../byterun/gc.h \
- ../../byterun/major_gc.h ../../byterun/freelist.h \
- ../../byterun/minor_gc.h unixsupport.h
+  ../../byterun/compatibility.h ../../byterun/config.h \
+  ../../byterun/../config/m.h ../../byterun/../config/s.h \
+  ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \
+  ../../byterun/fail.h ../../byterun/memory.h ../../byterun/gc.h \
+  ../../byterun/major_gc.h ../../byterun/freelist.h \
+  ../../byterun/minor_gc.h unixsupport.h
 getsockname.o: getsockname.c ../../byterun/fail.h \
- ../../byterun/compatibility.h ../../byterun/misc.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/mlvalues.h \
- ../../byterun/mlvalues.h unixsupport.h socketaddr.h ../../byterun/misc.h
+  ../../byterun/compatibility.h ../../byterun/misc.h \
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/mlvalues.h \
+  ../../byterun/mlvalues.h unixsupport.h socketaddr.h \
+  ../../byterun/misc.h
 gettimeofday.o: gettimeofday.c ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \
- ../../byterun/fail.h unixsupport.h
+  ../../byterun/compatibility.h ../../byterun/config.h \
+  ../../byterun/../config/m.h ../../byterun/../config/s.h \
+  ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \
+  ../../byterun/fail.h unixsupport.h
 getuid.o: getuid.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h unixsupport.h
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/misc.h unixsupport.h
 gmtime.o: gmtime.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \
- ../../byterun/mlvalues.h ../../byterun/fail.h ../../byterun/memory.h \
- ../../byterun/gc.h ../../byterun/major_gc.h ../../byterun/freelist.h \
- ../../byterun/minor_gc.h unixsupport.h
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \
+  ../../byterun/mlvalues.h ../../byterun/fail.h ../../byterun/memory.h \
+  ../../byterun/gc.h ../../byterun/major_gc.h ../../byterun/freelist.h \
+  ../../byterun/minor_gc.h unixsupport.h
 initgroups.o: initgroups.c ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \
- ../../byterun/fail.h unixsupport.h
+  ../../byterun/compatibility.h ../../byterun/config.h \
+  ../../byterun/../config/m.h ../../byterun/../config/s.h \
+  ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \
+  ../../byterun/fail.h unixsupport.h
 isatty.o: isatty.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h unixsupport.h
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/misc.h unixsupport.h
 itimer.o: itimer.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \
- ../../byterun/mlvalues.h ../../byterun/fail.h ../../byterun/memory.h \
- ../../byterun/gc.h ../../byterun/major_gc.h ../../byterun/freelist.h \
- ../../byterun/minor_gc.h unixsupport.h
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \
+  ../../byterun/mlvalues.h ../../byterun/fail.h ../../byterun/memory.h \
+  ../../byterun/gc.h ../../byterun/major_gc.h ../../byterun/freelist.h \
+  ../../byterun/minor_gc.h unixsupport.h
 kill.o: kill.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/fail.h \
- ../../byterun/mlvalues.h unixsupport.h ../../byterun/signals.h
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/fail.h \
+  ../../byterun/mlvalues.h unixsupport.h ../../byterun/signals.h
 link.o: link.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/memory.h \
- ../../byterun/gc.h ../../byterun/mlvalues.h ../../byterun/major_gc.h \
- ../../byterun/freelist.h ../../byterun/minor_gc.h \
- ../../byterun/signals.h unixsupport.h
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/memory.h \
+  ../../byterun/gc.h ../../byterun/mlvalues.h ../../byterun/major_gc.h \
+  ../../byterun/freelist.h ../../byterun/minor_gc.h \
+  ../../byterun/signals.h unixsupport.h
 listen.o: listen.c ../../byterun/fail.h ../../byterun/compatibility.h \
- ../../byterun/misc.h ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/mlvalues.h \
- ../../byterun/mlvalues.h unixsupport.h
+  ../../byterun/misc.h ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/mlvalues.h \
+  ../../byterun/mlvalues.h unixsupport.h
 lockf.o: lockf.c ../../byterun/fail.h ../../byterun/compatibility.h \
- ../../byterun/misc.h ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/mlvalues.h \
- ../../byterun/mlvalues.h ../../byterun/signals.h unixsupport.h
+  ../../byterun/misc.h ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/mlvalues.h \
+  ../../byterun/mlvalues.h ../../byterun/signals.h unixsupport.h
 lseek.o: lseek.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \
- ../../byterun/mlvalues.h ../../byterun/io.h ../../byterun/signals.h \
- unixsupport.h
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \
+  ../../byterun/mlvalues.h ../../byterun/io.h ../../byterun/signals.h \
+  unixsupport.h
 mkdir.o: mkdir.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/memory.h \
- ../../byterun/gc.h ../../byterun/mlvalues.h ../../byterun/major_gc.h \
- ../../byterun/freelist.h ../../byterun/minor_gc.h \
- ../../byterun/signals.h unixsupport.h
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/memory.h \
+  ../../byterun/gc.h ../../byterun/mlvalues.h ../../byterun/major_gc.h \
+  ../../byterun/freelist.h ../../byterun/minor_gc.h \
+  ../../byterun/signals.h unixsupport.h
 mkfifo.o: mkfifo.c ../../byterun/fail.h ../../byterun/compatibility.h \
- ../../byterun/misc.h ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/mlvalues.h \
- ../../byterun/mlvalues.h ../../byterun/memory.h ../../byterun/gc.h \
- ../../byterun/major_gc.h ../../byterun/freelist.h \
- ../../byterun/minor_gc.h ../../byterun/signals.h unixsupport.h
+  ../../byterun/misc.h ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/mlvalues.h \
+  ../../byterun/mlvalues.h ../../byterun/memory.h ../../byterun/gc.h \
+  ../../byterun/major_gc.h ../../byterun/freelist.h \
+  ../../byterun/minor_gc.h ../../byterun/signals.h unixsupport.h
 nice.o: nice.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h unixsupport.h
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/misc.h unixsupport.h
 open.o: open.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \
- ../../byterun/mlvalues.h ../../byterun/memory.h ../../byterun/gc.h \
- ../../byterun/major_gc.h ../../byterun/freelist.h \
- ../../byterun/minor_gc.h ../../byterun/signals.h unixsupport.h
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \
+  ../../byterun/mlvalues.h ../../byterun/memory.h ../../byterun/gc.h \
+  ../../byterun/major_gc.h ../../byterun/freelist.h \
+  ../../byterun/minor_gc.h ../../byterun/signals.h unixsupport.h
 opendir.o: opendir.c ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../byterun/misc.h ../../byterun/memory.h ../../byterun/gc.h \
- ../../byterun/mlvalues.h ../../byterun/major_gc.h \
- ../../byterun/freelist.h ../../byterun/minor_gc.h ../../byterun/alloc.h \
- ../../byterun/signals.h unixsupport.h
+  ../../byterun/compatibility.h ../../byterun/config.h \
+  ../../byterun/../config/m.h ../../byterun/../config/s.h \
+  ../../byterun/misc.h ../../byterun/memory.h ../../byterun/gc.h \
+  ../../byterun/mlvalues.h ../../byterun/major_gc.h \
+  ../../byterun/freelist.h ../../byterun/minor_gc.h ../../byterun/alloc.h \
+  ../../byterun/signals.h unixsupport.h
 pipe.o: pipe.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \
- ../../byterun/mlvalues.h unixsupport.h
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \
+  ../../byterun/mlvalues.h unixsupport.h
 putenv.o: putenv.c ../../byterun/fail.h ../../byterun/compatibility.h \
- ../../byterun/misc.h ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/mlvalues.h \
- ../../byterun/memory.h ../../byterun/gc.h ../../byterun/major_gc.h \
- ../../byterun/freelist.h ../../byterun/minor_gc.h \
- ../../byterun/mlvalues.h unixsupport.h
+  ../../byterun/misc.h ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/mlvalues.h \
+  ../../byterun/memory.h ../../byterun/gc.h ../../byterun/major_gc.h \
+  ../../byterun/freelist.h ../../byterun/minor_gc.h \
+  ../../byterun/mlvalues.h unixsupport.h
 read.o: read.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/memory.h \
- ../../byterun/gc.h ../../byterun/mlvalues.h ../../byterun/major_gc.h \
- ../../byterun/freelist.h ../../byterun/minor_gc.h \
- ../../byterun/signals.h unixsupport.h
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/memory.h \
+  ../../byterun/gc.h ../../byterun/mlvalues.h ../../byterun/major_gc.h \
+  ../../byterun/freelist.h ../../byterun/minor_gc.h \
+  ../../byterun/signals.h unixsupport.h
 readdir.o: readdir.c ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../byterun/misc.h ../../byterun/fail.h ../../byterun/mlvalues.h \
- ../../byterun/alloc.h ../../byterun/signals.h unixsupport.h
+  ../../byterun/compatibility.h ../../byterun/config.h \
+  ../../byterun/../config/m.h ../../byterun/../config/s.h \
+  ../../byterun/misc.h ../../byterun/fail.h ../../byterun/mlvalues.h \
+  ../../byterun/alloc.h ../../byterun/signals.h unixsupport.h
 readlink.o: readlink.c ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../byterun/misc.h ../../byterun/memory.h ../../byterun/gc.h \
- ../../byterun/mlvalues.h ../../byterun/major_gc.h \
- ../../byterun/freelist.h ../../byterun/minor_gc.h ../../byterun/alloc.h \
- ../../byterun/fail.h ../../byterun/signals.h unixsupport.h
+  ../../byterun/compatibility.h ../../byterun/config.h \
+  ../../byterun/../config/m.h ../../byterun/../config/s.h \
+  ../../byterun/misc.h ../../byterun/memory.h ../../byterun/gc.h \
+  ../../byterun/mlvalues.h ../../byterun/major_gc.h \
+  ../../byterun/freelist.h ../../byterun/minor_gc.h ../../byterun/alloc.h \
+  ../../byterun/fail.h ../../byterun/signals.h unixsupport.h
 rename.o: rename.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/memory.h \
- ../../byterun/gc.h ../../byterun/mlvalues.h ../../byterun/major_gc.h \
- ../../byterun/freelist.h ../../byterun/minor_gc.h \
- ../../byterun/signals.h unixsupport.h
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/memory.h \
+  ../../byterun/gc.h ../../byterun/mlvalues.h ../../byterun/major_gc.h \
+  ../../byterun/freelist.h ../../byterun/minor_gc.h \
+  ../../byterun/signals.h unixsupport.h
 rewinddir.o: rewinddir.c ../../byterun/fail.h \
- ../../byterun/compatibility.h ../../byterun/misc.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/mlvalues.h \
- ../../byterun/mlvalues.h unixsupport.h
+  ../../byterun/compatibility.h ../../byterun/misc.h \
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/mlvalues.h \
+  ../../byterun/mlvalues.h unixsupport.h
 rmdir.o: rmdir.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/memory.h \
- ../../byterun/gc.h ../../byterun/mlvalues.h ../../byterun/major_gc.h \
- ../../byterun/freelist.h ../../byterun/minor_gc.h \
- ../../byterun/signals.h unixsupport.h
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/memory.h \
+  ../../byterun/gc.h ../../byterun/mlvalues.h ../../byterun/major_gc.h \
+  ../../byterun/freelist.h ../../byterun/minor_gc.h \
+  ../../byterun/signals.h unixsupport.h
 select.o: select.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \
- ../../byterun/mlvalues.h ../../byterun/fail.h ../../byterun/memory.h \
- ../../byterun/gc.h ../../byterun/major_gc.h ../../byterun/freelist.h \
- ../../byterun/minor_gc.h ../../byterun/signals.h unixsupport.h
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \
+  ../../byterun/mlvalues.h ../../byterun/fail.h ../../byterun/memory.h \
+  ../../byterun/gc.h ../../byterun/major_gc.h ../../byterun/freelist.h \
+  ../../byterun/minor_gc.h ../../byterun/signals.h unixsupport.h
 sendrecv.o: sendrecv.c ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \
- ../../byterun/fail.h ../../byterun/memory.h ../../byterun/gc.h \
- ../../byterun/major_gc.h ../../byterun/freelist.h \
- ../../byterun/minor_gc.h ../../byterun/signals.h unixsupport.h \
- socketaddr.h ../../byterun/misc.h
+  ../../byterun/compatibility.h ../../byterun/config.h \
+  ../../byterun/../config/m.h ../../byterun/../config/s.h \
+  ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \
+  ../../byterun/fail.h ../../byterun/memory.h ../../byterun/gc.h \
+  ../../byterun/major_gc.h ../../byterun/freelist.h \
+  ../../byterun/minor_gc.h ../../byterun/signals.h unixsupport.h \
+  socketaddr.h ../../byterun/misc.h
 setgid.o: setgid.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h unixsupport.h
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/misc.h unixsupport.h
 setgroups.o: setgroups.c ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \
- ../../byterun/fail.h ../../byterun/memory.h ../../byterun/gc.h \
- ../../byterun/major_gc.h ../../byterun/freelist.h \
- ../../byterun/minor_gc.h unixsupport.h
+  ../../byterun/compatibility.h ../../byterun/config.h \
+  ../../byterun/../config/m.h ../../byterun/../config/s.h \
+  ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \
+  ../../byterun/fail.h ../../byterun/memory.h ../../byterun/gc.h \
+  ../../byterun/major_gc.h ../../byterun/freelist.h \
+  ../../byterun/minor_gc.h unixsupport.h
 setsid.o: setsid.c ../../byterun/fail.h ../../byterun/compatibility.h \
- ../../byterun/misc.h ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/mlvalues.h \
- ../../byterun/mlvalues.h unixsupport.h
+  ../../byterun/misc.h ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/mlvalues.h \
+  ../../byterun/mlvalues.h unixsupport.h
 setuid.o: setuid.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h unixsupport.h
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/misc.h unixsupport.h
 shutdown.o: shutdown.c ../../byterun/fail.h ../../byterun/compatibility.h \
- ../../byterun/misc.h ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/mlvalues.h \
- ../../byterun/mlvalues.h unixsupport.h
+  ../../byterun/misc.h ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/mlvalues.h \
+  ../../byterun/mlvalues.h unixsupport.h
 signals.o: signals.c ../../byterun/alloc.h ../../byterun/compatibility.h \
- ../../byterun/misc.h ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/mlvalues.h \
- ../../byterun/fail.h ../../byterun/memory.h ../../byterun/gc.h \
- ../../byterun/major_gc.h ../../byterun/freelist.h \
- ../../byterun/minor_gc.h ../../byterun/mlvalues.h \
- ../../byterun/signals.h unixsupport.h
+  ../../byterun/misc.h ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/mlvalues.h \
+  ../../byterun/fail.h ../../byterun/memory.h ../../byterun/gc.h \
+  ../../byterun/major_gc.h ../../byterun/freelist.h \
+  ../../byterun/minor_gc.h ../../byterun/mlvalues.h \
+  ../../byterun/signals.h unixsupport.h
 sleep.o: sleep.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/signals.h \
- ../../byterun/mlvalues.h unixsupport.h
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/misc.h \
+  ../../byterun/signals.h ../../byterun/mlvalues.h unixsupport.h
 socket.o: socket.c ../../byterun/fail.h ../../byterun/compatibility.h \
- ../../byterun/misc.h ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/mlvalues.h \
- ../../byterun/mlvalues.h unixsupport.h
+  ../../byterun/misc.h ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/mlvalues.h \
+  ../../byterun/mlvalues.h unixsupport.h
 socketaddr.o: socketaddr.c ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \
- ../../byterun/memory.h ../../byterun/gc.h ../../byterun/major_gc.h \
- ../../byterun/freelist.h ../../byterun/minor_gc.h unixsupport.h \
- socketaddr.h ../../byterun/misc.h
+  ../../byterun/compatibility.h ../../byterun/config.h \
+  ../../byterun/../config/m.h ../../byterun/../config/s.h \
+  ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \
+  ../../byterun/memory.h ../../byterun/gc.h ../../byterun/major_gc.h \
+  ../../byterun/freelist.h ../../byterun/minor_gc.h unixsupport.h \
+  socketaddr.h ../../byterun/misc.h
 socketpair.o: socketpair.c ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \
- ../../byterun/fail.h unixsupport.h
+  ../../byterun/compatibility.h ../../byterun/config.h \
+  ../../byterun/../config/m.h ../../byterun/../config/s.h \
+  ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \
+  ../../byterun/fail.h unixsupport.h
 sockopt.o: sockopt.c ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../byterun/misc.h ../../byterun/memory.h ../../byterun/gc.h \
- ../../byterun/mlvalues.h ../../byterun/major_gc.h \
- ../../byterun/freelist.h ../../byterun/minor_gc.h ../../byterun/alloc.h \
- ../../byterun/fail.h unixsupport.h socketaddr.h ../../byterun/misc.h
+  ../../byterun/compatibility.h ../../byterun/config.h \
+  ../../byterun/../config/m.h ../../byterun/../config/s.h \
+  ../../byterun/misc.h ../../byterun/memory.h ../../byterun/gc.h \
+  ../../byterun/mlvalues.h ../../byterun/major_gc.h \
+  ../../byterun/freelist.h ../../byterun/minor_gc.h ../../byterun/alloc.h \
+  ../../byterun/fail.h unixsupport.h socketaddr.h ../../byterun/misc.h
 stat.o: stat.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/memory.h \
- ../../byterun/gc.h ../../byterun/mlvalues.h ../../byterun/major_gc.h \
- ../../byterun/freelist.h ../../byterun/minor_gc.h ../../byterun/alloc.h \
- ../../byterun/signals.h unixsupport.h cst2constr.h ../../byterun/io.h
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/memory.h \
+  ../../byterun/gc.h ../../byterun/mlvalues.h ../../byterun/major_gc.h \
+  ../../byterun/freelist.h ../../byterun/minor_gc.h ../../byterun/alloc.h \
+  ../../byterun/signals.h unixsupport.h cst2constr.h ../../byterun/io.h
 strofaddr.o: strofaddr.c ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \
- ../../byterun/fail.h unixsupport.h socketaddr.h ../../byterun/misc.h
+  ../../byterun/compatibility.h ../../byterun/config.h \
+  ../../byterun/../config/m.h ../../byterun/../config/s.h \
+  ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \
+  ../../byterun/fail.h unixsupport.h socketaddr.h ../../byterun/misc.h
 symlink.o: symlink.c ../../byterun/fail.h ../../byterun/compatibility.h \
- ../../byterun/misc.h ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/mlvalues.h \
- ../../byterun/mlvalues.h ../../byterun/memory.h ../../byterun/gc.h \
- ../../byterun/major_gc.h ../../byterun/freelist.h \
- ../../byterun/minor_gc.h ../../byterun/signals.h unixsupport.h
+  ../../byterun/misc.h ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/mlvalues.h \
+  ../../byterun/mlvalues.h ../../byterun/memory.h ../../byterun/gc.h \
+  ../../byterun/major_gc.h ../../byterun/freelist.h \
+  ../../byterun/minor_gc.h ../../byterun/signals.h unixsupport.h
 termios.o: termios.c ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \
- ../../byterun/fail.h unixsupport.h
+  ../../byterun/compatibility.h ../../byterun/config.h \
+  ../../byterun/../config/m.h ../../byterun/../config/s.h \
+  ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \
+  ../../byterun/fail.h unixsupport.h
 time.o: time.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \
- ../../byterun/mlvalues.h unixsupport.h
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \
+  ../../byterun/mlvalues.h unixsupport.h
 times.o: times.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \
- ../../byterun/mlvalues.h ../../byterun/memory.h ../../byterun/gc.h \
- ../../byterun/major_gc.h ../../byterun/freelist.h \
- ../../byterun/minor_gc.h unixsupport.h
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \
+  ../../byterun/mlvalues.h ../../byterun/memory.h ../../byterun/gc.h \
+  ../../byterun/major_gc.h ../../byterun/freelist.h \
+  ../../byterun/minor_gc.h unixsupport.h
 truncate.o: truncate.c ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../byterun/misc.h ../../byterun/memory.h ../../byterun/gc.h \
- ../../byterun/mlvalues.h ../../byterun/major_gc.h \
- ../../byterun/freelist.h ../../byterun/minor_gc.h ../../byterun/fail.h \
- ../../byterun/signals.h ../../byterun/io.h unixsupport.h
+  ../../byterun/compatibility.h ../../byterun/config.h \
+  ../../byterun/../config/m.h ../../byterun/../config/s.h \
+  ../../byterun/misc.h ../../byterun/memory.h ../../byterun/gc.h \
+  ../../byterun/mlvalues.h ../../byterun/major_gc.h \
+  ../../byterun/freelist.h ../../byterun/minor_gc.h ../../byterun/fail.h \
+  ../../byterun/signals.h ../../byterun/io.h unixsupport.h
 umask.o: umask.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h unixsupport.h
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/misc.h unixsupport.h
 unixsupport.o: unixsupport.c ../../byterun/mlvalues.h \
- ../../byterun/compatibility.h ../../byterun/config.h \
- ../../byterun/../config/m.h ../../byterun/../config/s.h \
- ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \
- ../../byterun/callback.h ../../byterun/memory.h ../../byterun/gc.h \
- ../../byterun/major_gc.h ../../byterun/freelist.h \
- ../../byterun/minor_gc.h ../../byterun/fail.h unixsupport.h cst2constr.h
+  ../../byterun/compatibility.h ../../byterun/config.h \
+  ../../byterun/../config/m.h ../../byterun/../config/s.h \
+  ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \
+  ../../byterun/callback.h ../../byterun/memory.h ../../byterun/gc.h \
+  ../../byterun/major_gc.h ../../byterun/freelist.h \
+  ../../byterun/minor_gc.h ../../byterun/fail.h unixsupport.h \
+  cst2constr.h
 unlink.o: unlink.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/memory.h \
- ../../byterun/gc.h ../../byterun/mlvalues.h ../../byterun/major_gc.h \
- ../../byterun/freelist.h ../../byterun/minor_gc.h \
- ../../byterun/signals.h unixsupport.h
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/memory.h \
+  ../../byterun/gc.h ../../byterun/mlvalues.h ../../byterun/major_gc.h \
+  ../../byterun/freelist.h ../../byterun/minor_gc.h \
+  ../../byterun/signals.h unixsupport.h
 utimes.o: utimes.c ../../byterun/fail.h ../../byterun/compatibility.h \
- ../../byterun/misc.h ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/mlvalues.h \
- ../../byterun/mlvalues.h ../../byterun/memory.h ../../byterun/gc.h \
- ../../byterun/major_gc.h ../../byterun/freelist.h \
- ../../byterun/minor_gc.h ../../byterun/signals.h unixsupport.h
+  ../../byterun/misc.h ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/mlvalues.h \
+  ../../byterun/mlvalues.h ../../byterun/memory.h ../../byterun/gc.h \
+  ../../byterun/major_gc.h ../../byterun/freelist.h \
+  ../../byterun/minor_gc.h ../../byterun/signals.h unixsupport.h
 wait.o: wait.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \
- ../../byterun/mlvalues.h ../../byterun/fail.h ../../byterun/memory.h \
- ../../byterun/gc.h ../../byterun/major_gc.h ../../byterun/freelist.h \
- ../../byterun/minor_gc.h ../../byterun/signals.h unixsupport.h
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \
+  ../../byterun/mlvalues.h ../../byterun/fail.h ../../byterun/memory.h \
+  ../../byterun/gc.h ../../byterun/major_gc.h ../../byterun/freelist.h \
+  ../../byterun/minor_gc.h ../../byterun/signals.h unixsupport.h
 write.o: write.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \
- ../../byterun/config.h ../../byterun/../config/m.h \
- ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/memory.h \
- ../../byterun/gc.h ../../byterun/mlvalues.h ../../byterun/major_gc.h \
- ../../byterun/freelist.h ../../byterun/minor_gc.h \
- ../../byterun/signals.h unixsupport.h
+  ../../byterun/config.h ../../byterun/../config/m.h \
+  ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/memory.h \
+  ../../byterun/gc.h ../../byterun/mlvalues.h ../../byterun/major_gc.h \
+  ../../byterun/freelist.h ../../byterun/minor_gc.h \
+  ../../byterun/signals.h unixsupport.h
 unix.cmi :
 unixLabels.cmi : unix.cmi
 unix.cmo : unix.cmi
diff --git a/otherlibs/unix/unix.ml b/otherlibs/unix/unix.ml
index 8bd935f4cb..d18b338adb 100644
--- a/otherlibs/unix/unix.ml
+++ b/otherlibs/unix/unix.ml
@@ -237,27 +237,34 @@ external openfile : string -> open_flag list -> file_perm -> file_descr
            = "unix_open"
 
 external close : file_descr -> unit = "unix_close"
-external unsafe_read : file_descr -> string -> int -> int -> int = "unix_read"
-external unsafe_write : file_descr -> string -> int -> int -> int = "unix_write"
-external unsafe_single_write : file_descr -> string -> int -> int -> int
+external unsafe_read : file_descr -> bytes -> int -> int -> int
+   = "unix_read"
+external unsafe_write : file_descr -> bytes -> int -> int -> int = "unix_write"
+external unsafe_single_write : file_descr -> bytes -> int -> int -> int
    = "unix_single_write"
 
 let read fd buf ofs len =
-  if ofs < 0 || len < 0 || ofs > String.length buf - len
+  if ofs < 0 || len < 0 || ofs > Bytes.length buf - len
   then invalid_arg "Unix.read"
   else unsafe_read fd buf ofs len
 let write fd buf ofs len =
-  if ofs < 0 || len < 0 || ofs > String.length buf - len
+  if ofs < 0 || len < 0 || ofs > Bytes.length buf - len
   then invalid_arg "Unix.write"
   else unsafe_write fd buf ofs len
 (* write misbehaves because it attempts to write all data by making repeated
    calls to the Unix write function (see comment in write.c and unix.mli).
-   partial_write fixes this by never calling write twice. *)
+   single_write fixes this by never calling write twice. *)
 let single_write fd buf ofs len =
-  if ofs < 0 || len < 0 || ofs > String.length buf - len
+  if ofs < 0 || len < 0 || ofs > Bytes.length buf - len
   then invalid_arg "Unix.single_write"
   else unsafe_single_write fd buf ofs len
 
+let write_substring fd buf ofs len =
+  write fd (Bytes.unsafe_of_string buf) ofs len
+
+let single_write_substring fd buf ofs len =
+  single_write fd (Bytes.unsafe_of_string buf) ofs len
+
 external in_channel_of_descr : file_descr -> in_channel
                              = "caml_ml_open_descriptor_in"
 external out_channel_of_descr : file_descr -> out_channel
@@ -529,35 +536,41 @@ external getsockname : file_descr -> sockaddr = "unix_getsockname"
 external getpeername : file_descr -> sockaddr = "unix_getpeername"
 
 external unsafe_recv :
-  file_descr -> string -> int -> int -> msg_flag list -> int
+  file_descr -> bytes -> int -> int -> msg_flag list -> int
                                   = "unix_recv"
 external unsafe_recvfrom :
-  file_descr -> string -> int -> int -> msg_flag list -> int * sockaddr
+  file_descr -> bytes -> int -> int -> msg_flag list -> int * sockaddr
                                   = "unix_recvfrom"
 external unsafe_send :
-  file_descr -> string -> int -> int -> msg_flag list -> int
+  file_descr -> bytes -> int -> int -> msg_flag list -> int
                                   = "unix_send"
 external unsafe_sendto :
-  file_descr -> string -> int -> int -> msg_flag list -> sockaddr -> int
+  file_descr -> bytes -> int -> int -> msg_flag list -> sockaddr -> int
                                   = "unix_sendto" "unix_sendto_native"
 
 let recv fd buf ofs len flags =
-  if ofs < 0 || len < 0 || ofs > String.length buf - len
+  if ofs < 0 || len < 0 || ofs > Bytes.length buf - len
   then invalid_arg "Unix.recv"
   else unsafe_recv fd buf ofs len flags
 let recvfrom fd buf ofs len flags =
-  if ofs < 0 || len < 0 || ofs > String.length buf - len
+  if ofs < 0 || len < 0 || ofs > Bytes.length buf - len
   then invalid_arg "Unix.recvfrom"
   else unsafe_recvfrom fd buf ofs len flags
 let send fd buf ofs len flags =
-  if ofs < 0 || len < 0 || ofs > String.length buf - len
+  if ofs < 0 || len < 0 || ofs > Bytes.length buf - len
   then invalid_arg "Unix.send"
   else unsafe_send fd buf ofs len flags
 let sendto fd buf ofs len flags addr =
-  if ofs < 0 || len < 0 || ofs > String.length buf - len
+  if ofs < 0 || len < 0 || ofs > Bytes.length buf - len
   then invalid_arg "Unix.sendto"
   else unsafe_sendto fd buf ofs len flags addr
 
+let send_substring fd buf ofs len flags =
+  send fd (Bytes.unsafe_of_string buf) ofs len flags
+
+let sendto_substring fd buf ofs len flags addr =
+  sendto fd (Bytes.unsafe_of_string buf) ofs len flags addr
+
 type socket_bool_option =
     SO_DEBUG
   | SO_BROADCAST
diff --git a/otherlibs/unix/unix.mli b/otherlibs/unix/unix.mli
index efc3fe6fc4..59e5199357 100644
--- a/otherlibs/unix/unix.mli
+++ b/otherlibs/unix/unix.mli
@@ -259,23 +259,31 @@ val openfile : string -> open_flag list -> file_perm -> file_descr
 val close : file_descr -> unit
 (** Close a file descriptor. *)
 
-val read : file_descr -> string -> int -> int -> int
-(** [read fd buff ofs len] reads [len] characters from descriptor
-   [fd], storing them in string [buff], starting at position [ofs]
-   in string [buff]. Return the number of characters actually read. *)
-
-val write : file_descr -> string -> int -> int -> int
-(** [write fd buff ofs len] writes [len] characters to descriptor
-   [fd], taking them from string [buff], starting at position [ofs]
-   in string [buff]. Return the number of characters actually
-   written.  [write] repeats the writing operation until all characters
-   have been written or an error occurs.  *)
-
-val single_write : file_descr -> string -> int -> int -> int
+val read : file_descr -> bytes -> int -> int -> int
+(** [read fd buff ofs len] reads [len] bytes from descriptor [fd],
+    storing them in byte sequence [buff], starting at position [ofs] in
+    [buff]. Return the number of bytes actually read. *)
+
+val write : file_descr -> bytes -> int -> int -> int
+(** [write fd buff ofs len] writes [len] bytes to descriptor [fd],
+    taking them from byte sequence [buff], starting at position [ofs]
+    in [buff]. Return the number of bytes actually written.  [write]
+    repeats the writing operation until all bytes have been written or
+    an error occurs.  *)
+
+val single_write : file_descr -> bytes -> int -> int -> int
 (** Same as [write], but attempts to write only once.
    Thus, if an error occurs, [single_write] guarantees that no data
    has been written. *)
 
+val write_substring : file_descr -> string -> int -> int -> int
+(** Same as [write], but take the data from a string instead of a byte
+    sequence. *)
+
+val single_write_substring : file_descr -> string -> int -> int -> int
+(** Same as [single_write], but take the data from a string instead of
+    a byte sequence. *)
+
 (** {6 Interfacing with the standard input/output library} *)
 
 
@@ -994,20 +1002,28 @@ type msg_flag =
 (** The flags for {!Unix.recv},  {!Unix.recvfrom},
    {!Unix.send} and {!Unix.sendto}. *)
 
-val recv : file_descr -> string -> int -> int -> msg_flag list -> int
+val recv : file_descr -> bytes -> int -> int -> msg_flag list -> int
 (** Receive data from a connected socket. *)
 
 val recvfrom :
-  file_descr -> string -> int -> int -> msg_flag list -> int * sockaddr
+  file_descr -> bytes -> int -> int -> msg_flag list -> int * sockaddr
 (** Receive data from an unconnected socket. *)
 
-val send : file_descr -> string -> int -> int -> msg_flag list -> int
+val send : file_descr -> bytes -> int -> int -> msg_flag list -> int
 (** Send data over a connected socket. *)
 
+val send_substring : file_descr -> string -> int -> int -> msg_flag list -> int
+(** Same as [send], but take the data from a string instead of a byte
+    sequence. *)
+
 val sendto :
-  file_descr -> string -> int -> int -> msg_flag list -> sockaddr -> int
+  file_descr -> bytes -> int -> int -> msg_flag list -> sockaddr -> int
 (** Send data over an unconnected socket. *)
 
+val sendto_substring :
+  file_descr -> string -> int -> int -> msg_flag list -> sockaddr -> int
+(** Same as [sendto], but take the data from a string instead of a
+    byte sequence. *)
 
 
 (** {6 Socket options} *)
diff --git a/otherlibs/unix/unixLabels.mli b/otherlibs/unix/unixLabels.mli
index 53e16b1d76..76ff890b12 100644
--- a/otherlibs/unix/unixLabels.mli
+++ b/otherlibs/unix/unixLabels.mli
@@ -261,23 +261,32 @@ val openfile : string -> mode:open_flag list -> perm:file_perm -> file_descr
 val close : file_descr -> unit
 (** Close a file descriptor. *)
 
-val read : file_descr -> buf:string -> pos:int -> len:int -> int
-(** [read fd buff ofs len] reads [len] characters from descriptor
-   [fd], storing them in string [buff], starting at position [ofs]
-   in string [buff]. Return the number of characters actually read. *)
-
-val write : file_descr -> buf:string -> pos:int -> len:int -> int
-(** [write fd buff ofs len] writes [len] characters to descriptor
-   [fd], taking them from string [buff], starting at position [ofs]
-   in string [buff]. Return the number of characters actually
-   written.  [write] repeats the writing operation until all characters
-   have been written or an error occurs.  *)
-
-val single_write : file_descr -> buf:string -> pos:int -> len:int -> int
+val read : file_descr -> buf:bytes -> pos:int -> len:int -> int
+(** [read fd buff ofs len] reads [len] bytes from descriptor [fd],
+    storing them in byte sequence [buff], starting at position [ofs] in
+    [buff]. Return the number of bytes actually read. *)
+
+val write : file_descr -> buf:bytes -> pos:int -> len:int -> int
+(** [write fd buff ofs len] writes [len] bytes to descriptor [fd],
+    taking them from byte sequence [buff], starting at position [ofs]
+    in [buff]. Return the number of bytes actually written.  [write]
+    repeats the writing operation until all bytes have been written or
+    an error occurs.  *)
+
+val single_write : file_descr -> buf:bytes -> pos:int -> len:int -> int
 (** Same as [write], but attempts to write only once.
    Thus, if an error occurs, [single_write] guarantees that no data
    has been written. *)
 
+val write_substring : file_descr -> buf:string -> pos:int -> len:int -> int
+(** Same as [write], but take the data from a string instead of a byte
+    sequence. *)
+
+val single_write_substring :
+  file_descr -> buf:string -> pos:int -> len:int -> int
+(** Same as [single_write], but take the data from a string instead of
+    a byte sequence. *)
+
 (** {6 Interfacing with the standard input/output library} *)
 
 
@@ -1000,23 +1009,34 @@ type msg_flag = Unix.msg_flag =
    {!UnixLabels.send} and {!UnixLabels.sendto}. *)
 
 val recv :
-  file_descr -> buf:string -> pos:int -> len:int -> mode:msg_flag list -> int
+  file_descr -> buf:bytes -> pos:int -> len:int -> mode:msg_flag list -> int
 (** Receive data from a connected socket. *)
 
 val recvfrom :
-  file_descr -> buf:string -> pos:int -> len:int -> mode:msg_flag list ->
+  file_descr -> buf:bytes -> pos:int -> len:int -> mode:msg_flag list ->
     int * sockaddr
 (** Receive data from an unconnected socket. *)
 
 val send :
-  file_descr -> buf:string -> pos:int -> len:int -> mode:msg_flag list -> int
+  file_descr -> buf:bytes -> pos:int -> len:int -> mode:msg_flag list -> int
 (** Send data over a connected socket. *)
 
+val send_substring :
+  file_descr -> buf:string -> pos:int -> len:int -> mode:msg_flag list -> int
+(** Same as [send], but take the data from a string instead of a byte
+    sequence. *)
+
 val sendto :
-  file_descr -> buf:string -> pos:int -> len:int -> mode:msg_flag list ->
+  file_descr -> buf:bytes -> pos:int -> len:int -> mode:msg_flag list ->
     addr:sockaddr -> int
 (** Send data over an unconnected socket. *)
 
+val sendto_substring :
+  file_descr -> bug:string -> pos:int -> len:int -> mode:msg_flag list
+  -> sockaddr -> int
+(** Same as [sendto], but take the data from a string instead of a
+    byte sequence. *)
+
 
 
 (** {6 Socket options} *)
diff --git a/otherlibs/win32unix/unix.ml b/otherlibs/win32unix/unix.ml
index 6c271ade2f..8866a2cd50 100644
--- a/otherlibs/win32unix/unix.ml
+++ b/otherlibs/win32unix/unix.ml
@@ -176,26 +176,32 @@ type file_perm = int
 external openfile : string -> open_flag list -> file_perm -> file_descr
            = "unix_open"
 external close : file_descr -> unit = "unix_close"
-external unsafe_read : file_descr -> string -> int -> int -> int
+external unsafe_read : file_descr -> bytes -> int -> int -> int
                      = "unix_read"
-external unsafe_write : file_descr -> string -> int -> int -> int
+external unsafe_write : file_descr -> bytes -> int -> int -> int
                       = "unix_write"
-external unsafe_single_write : file_descr -> string -> int -> int -> int
+external unsafe_single_write : file_descr -> bytes -> int -> int -> int
                       = "unix_single_write"
 
 let read fd buf ofs len =
-  if ofs < 0 || len < 0 || ofs > String.length buf - len
+  if ofs < 0 || len < 0 || ofs > Bytes.length buf - len
   then invalid_arg "Unix.read"
   else unsafe_read fd buf ofs len
 let write fd buf ofs len =
-  if ofs < 0 || len < 0 || ofs > String.length buf - len
+  if ofs < 0 || len < 0 || ofs > Bytes.length buf - len
   then invalid_arg "Unix.write"
   else unsafe_write fd buf ofs len
 let single_write fd buf ofs len =
-  if ofs < 0 || len < 0 || ofs > String.length buf - len
+  if ofs < 0 || len < 0 || ofs > Bytes.length buf - len
   then invalid_arg "Unix.single_write"
   else unsafe_single_write fd buf ofs len
 
+let write_substring fd buf ofs len =
+  write fd (Bytes.unsafe_of_string buf) ofs len
+
+let single_write_substring fd buf ofs len =
+  single_write fd (Bytes.unsafe_of_string buf) ofs len
+
 (* Interfacing with the standard input/output library *)
 
 external in_channel_of_descr: file_descr -> in_channel
@@ -535,35 +541,41 @@ external getsockname : file_descr -> sockaddr = "unix_getsockname"
 external getpeername : file_descr -> sockaddr = "unix_getpeername"
 
 external unsafe_recv :
-  file_descr -> string -> int -> int -> msg_flag list -> int
+  file_descr -> bytes -> int -> int -> msg_flag list -> int
                                   = "unix_recv"
 external unsafe_recvfrom :
-  file_descr -> string -> int -> int -> msg_flag list -> int * sockaddr
+  file_descr -> bytes -> int -> int -> msg_flag list -> int * sockaddr
                                   = "unix_recvfrom"
 external unsafe_send :
-  file_descr -> string -> int -> int -> msg_flag list -> int
+  file_descr -> bytes -> int -> int -> msg_flag list -> int
                                   = "unix_send"
 external unsafe_sendto :
-  file_descr -> string -> int -> int -> msg_flag list -> sockaddr -> int
+  file_descr -> bytes -> int -> int -> msg_flag list -> sockaddr -> int
                                   = "unix_sendto" "unix_sendto_native"
 
 let recv fd buf ofs len flags =
-  if ofs < 0 || len < 0 || ofs > String.length buf - len
+  if ofs < 0 || len < 0 || ofs > Bytes.length buf - len
   then invalid_arg "Unix.recv"
   else unsafe_recv fd buf ofs len flags
 let recvfrom fd buf ofs len flags =
-  if ofs < 0 || len < 0 || ofs > String.length buf - len
+  if ofs < 0 || len < 0 || ofs > Bytes.length buf - len
   then invalid_arg "Unix.recvfrom"
   else unsafe_recvfrom fd buf ofs len flags
 let send fd buf ofs len flags =
-  if ofs < 0 || len < 0 || ofs > String.length buf - len
+  if ofs < 0 || len < 0 || ofs > Bytes.length buf - len
   then invalid_arg "Unix.send"
   else unsafe_send fd buf ofs len flags
 let sendto fd buf ofs len flags addr =
-  if ofs < 0 || len < 0 || ofs > String.length buf - len
+  if ofs < 0 || len < 0 || ofs > Bytes.length buf - len
   then invalid_arg "Unix.sendto"
   else unsafe_sendto fd buf ofs len flags addr
 
+let send_substring fd buf ofs len flags =
+  send fd (Bytes.unsafe_of_string buf) ofs len flags
+
+let sendto_substring fd buf ofs len flags addr =
+  sendto fd (Bytes.unsafe_of_string buf) ofs len flags addr
+
 type socket_bool_option =
     SO_DEBUG
   | SO_BROADCAST
diff --git a/parsing/ast_helper.ml b/parsing/ast_helper.ml
index bcc4d83653..f53cb29288 100644
--- a/parsing/ast_helper.ml
+++ b/parsing/ast_helper.ml
@@ -72,6 +72,7 @@ module Pat = struct
   let type_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_type a)
   let lazy_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_lazy a)
   let unpack ?loc ?attrs a = mk ?loc ?attrs (Ppat_unpack a)
+  let exception_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_exception a)
   let extension ?loc ?attrs a = mk ?loc ?attrs (Ppat_extension a)
 end
 
@@ -157,6 +158,7 @@ module Sig = struct
 
   let value ?loc a = mk ?loc (Psig_value a)
   let type_ ?loc a = mk ?loc (Psig_type a)
+  let type_extension ?loc a = mk ?loc (Psig_typext a)
   let exception_ ?loc a = mk ?loc (Psig_exception a)
   let module_ ?loc a = mk ?loc (Psig_module a)
   let rec_module ?loc a = mk ?loc (Psig_recmodule a)
@@ -176,8 +178,8 @@ module Str = struct
   let value ?loc a b = mk ?loc (Pstr_value (a, b))
   let primitive ?loc a = mk ?loc (Pstr_primitive a)
   let type_ ?loc a = mk ?loc (Pstr_type a)
+  let type_extension ?loc a = mk ?loc (Pstr_typext a)
   let exception_ ?loc a = mk ?loc (Pstr_exception a)
-  let exn_rebind ?loc a = mk ?loc (Pstr_exn_rebind a)
   let module_ ?loc a = mk ?loc (Pstr_module a)
   let rec_module ?loc a = mk ?loc (Pstr_recmodule a)
   let modtype ?loc a = mk ?loc (Pstr_modtype a)
@@ -236,6 +238,7 @@ module Ctf = struct
   let method_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pctf_method (a, b, c, d))
   let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pctf_constraint (a, b))
   let extension ?loc ?attrs a = mk ?loc ?attrs (Pctf_extension a)
+  let attribute ?loc a = mk ?loc (Pctf_attribute a)
 end
 
 module Cf = struct
@@ -253,6 +256,7 @@ module Cf = struct
   let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pcf_constraint (a, b))
   let initializer_ ?loc ?attrs a = mk ?loc ?attrs (Pcf_initializer a)
   let extension ?loc ?attrs a = mk ?loc ?attrs (Pcf_extension a)
+  let attribute ?loc a = mk ?loc (Pcf_attribute a)
 
   let virtual_ ct = Cfk_virtual ct
   let concrete o e = Cfk_concrete (o, e)
@@ -379,6 +383,43 @@ module Type = struct
     }
 end
 
+(** Type extensions *)
+module Te = struct
+  let mk ?(attrs = []) ?(params = []) ?(priv = Public) path constructors =
+    {
+     ptyext_path = path;
+     ptyext_params = params;
+     ptyext_constructors = constructors;
+     ptyext_private = priv;
+     ptyext_attributes = attrs;
+    }
+
+  let constructor ?(loc = !default_loc) ?(attrs = []) name kind =
+    {
+     pext_name = name;
+     pext_kind = kind;
+     pext_loc = loc;
+     pext_attributes = attrs;
+    }
+
+  let decl ?(loc = !default_loc) ?(attrs = []) ?(args = Pcstr_tuple []) ?res name =
+    {
+     pext_name = name;
+     pext_kind = Pext_decl(args, res);
+     pext_loc = loc;
+     pext_attributes = attrs;
+    }
+
+  let rebind ?(loc = !default_loc) ?(attrs = []) name lid =
+    {
+     pext_name = name;
+     pext_kind = Pext_rebind lid;
+     pext_loc = loc;
+     pext_attributes = attrs;
+    }
+end
+
+
 module Csig = struct
   let mk self fields =
     {
@@ -394,84 +435,3 @@ module Cstr = struct
      pcstr_fields = fields;
     }
 end
-
-module Exrb = struct
-  let mk ?(loc  = !default_loc) ?(attrs = []) name lid =
-    {
-     pexrb_name = name;
-     pexrb_lid = lid;
-     pexrb_attributes = attrs;
-     pexrb_loc = loc;
-    }
-end
-
-module Convenience = struct
-  open Location
-
-  let may_tuple tup = function
-    | [] -> None
-    | [x] -> Some x
-    | l -> Some (tup ?loc:None ?attrs:None l)
-
-  let lid s = mkloc (Longident.parse s) !default_loc
-  let tuple l = Exp.tuple l
-  let constr s args = Exp.construct (lid s) (may_tuple Exp.tuple args)
-  let nil () = constr "[]" []
-  let unit () = constr "()" []
-  let cons hd tl = constr "::" [hd; tl]
-  let list l = List.fold_right cons l (nil ())
-  let str s = Exp.constant (Const_string (s, None))
-  let int x = Exp.constant (Const_int x)
-  let char x = Exp.constant (Const_char x)
-  let float x = Exp.constant (Const_float (string_of_float x))
-  let record ?over l =
-    Exp.record (List.map (fun (s, e) -> (lid s, e)) l) over
-  let func l = Exp.function_ (List.map (fun (p, e) -> Exp.case p e) l)
-  let lam ?(label = "") ?default pat exp = Exp.fun_ label default pat exp
-  let app f l = Exp.apply f (List.map (fun a -> "", a) l)
-  let evar s = Exp.ident (lid s)
-  let let_in ?(recursive = false) b body =
-    Exp.let_ (if recursive then Recursive else Nonrecursive) b body
-
-  let pvar s = Pat.var (mkloc s !default_loc)
-  let pconstr s args = Pat.construct (lid s) (may_tuple Pat.tuple args)
-  let precord ?(closed = Open) l =
-    Pat.record (List.map (fun (s, e) -> (lid s, e)) l) closed
-  let pnil () = pconstr "[]" []
-  let pcons hd tl = pconstr "::" [hd; tl]
-  let punit () = pconstr "()" []
-  let plist l = List.fold_right pcons l (pnil ())
-  let ptuple l = Pat.tuple l
-
-  let pstr s = Pat.constant (Const_string (s, None))
-  let pint x = Pat.constant (Const_int x)
-  let pchar x = Pat.constant (Const_char x)
-  let pfloat x = Pat.constant (Const_float (string_of_float x))
-
-  let tconstr c l = Typ.constr (lid c) l
-
-  let get_str = function
-    | {pexp_desc=Pexp_constant (Const_string (s, _)); _} -> Some s
-    | e -> None
-
-  let get_lid = function
-    | {pexp_desc=Pexp_ident{txt=id;_};_} ->
-        Some (String.concat "." (Longident.flatten id))
-    | _ -> None
-
-  let find_attr s attrs =
-    try Some (snd (List.find (fun (x, _) -> x.txt = s) attrs))
-    with Not_found -> None
-
-  let expr_of_payload = function
-    | PStr [{pstr_desc=Pstr_eval(e, _)}] -> Some e
-    | _ -> None
-
-  let find_attr_expr s attrs =
-    match find_attr s attrs with
-    | Some e -> expr_of_payload e
-    | None -> None
-
-  let has_attr s attrs =
-    find_attr s attrs <> None
-end
diff --git a/parsing/ast_helper.mli b/parsing/ast_helper.mli
index abf0cf9733..847d428f61 100644
--- a/parsing/ast_helper.mli
+++ b/parsing/ast_helper.mli
@@ -42,8 +42,9 @@ module Typ :
                -> core_type
     val tuple: ?loc:loc -> ?attrs:attrs -> core_type list -> core_type
     val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type
-    val object_: ?loc:loc -> ?attrs:attrs -> (string * core_type) list
-                 -> closed_flag -> core_type
+    val object_: ?loc:loc -> ?attrs:attrs ->
+                  (string * attributes * core_type) list -> closed_flag ->
+                  core_type
     val class_: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type
     val alias: ?loc:loc -> ?attrs:attrs -> core_type -> string -> core_type
     val variant: ?loc:loc -> ?attrs:attrs -> row_field list -> closed_flag
@@ -78,6 +79,7 @@ module Pat:
     val type_: ?loc:loc -> ?attrs:attrs -> lid -> pattern
     val lazy_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern
     val unpack: ?loc:loc -> ?attrs:attrs -> str -> pattern
+    val exception_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern
     val extension: ?loc:loc -> ?attrs:attrs -> extension -> pattern
   end
 
@@ -102,22 +104,33 @@ module Exp:
     val tuple: ?loc:loc -> ?attrs:attrs -> expression list -> expression
     val construct: ?loc:loc -> ?attrs:attrs -> lid -> expression option
                    -> expression
-    val variant: ?loc:loc -> ?attrs:attrs -> label -> expression option -> expression
-    val record: ?loc:loc -> ?attrs:attrs -> (lid * expression) list -> expression option -> expression
+    val variant: ?loc:loc -> ?attrs:attrs -> label -> expression option
+                 -> expression
+    val record: ?loc:loc -> ?attrs:attrs -> (lid * expression) list
+                -> expression option -> expression
     val field: ?loc:loc -> ?attrs:attrs -> expression -> lid -> expression
-    val setfield: ?loc:loc -> ?attrs:attrs -> expression -> lid -> expression -> expression
+    val setfield: ?loc:loc -> ?attrs:attrs -> expression -> lid -> expression
+                  -> expression
     val array: ?loc:loc -> ?attrs:attrs -> expression list -> expression
-    val ifthenelse: ?loc:loc -> ?attrs:attrs -> expression -> expression -> expression option -> expression
-    val sequence: ?loc:loc -> ?attrs:attrs -> expression -> expression -> expression
-    val while_: ?loc:loc -> ?attrs:attrs -> expression -> expression -> expression
-    val for_: ?loc:loc -> ?attrs:attrs -> pattern -> expression -> expression -> direction_flag -> expression -> expression
-    val coerce: ?loc:loc -> ?attrs:attrs -> expression -> core_type option -> core_type -> expression
-    val constraint_: ?loc:loc -> ?attrs:attrs -> expression -> core_type -> expression
+    val ifthenelse: ?loc:loc -> ?attrs:attrs -> expression -> expression
+                    -> expression option -> expression
+    val sequence: ?loc:loc -> ?attrs:attrs -> expression -> expression
+                  -> expression
+    val while_: ?loc:loc -> ?attrs:attrs -> expression -> expression
+                -> expression
+    val for_: ?loc:loc -> ?attrs:attrs -> pattern -> expression -> expression
+              -> direction_flag -> expression -> expression
+    val coerce: ?loc:loc -> ?attrs:attrs -> expression -> core_type option
+                -> core_type -> expression
+    val constraint_: ?loc:loc -> ?attrs:attrs -> expression -> core_type
+                     -> expression
     val send: ?loc:loc -> ?attrs:attrs -> expression -> string -> expression
     val new_: ?loc:loc -> ?attrs:attrs -> lid -> expression
     val setinstvar: ?loc:loc -> ?attrs:attrs -> str -> expression -> expression
-    val override: ?loc:loc -> ?attrs:attrs -> (str * expression) list -> expression
-    val letmodule: ?loc:loc -> ?attrs:attrs -> str -> module_expr -> expression -> expression
+    val override: ?loc:loc -> ?attrs:attrs -> (str * expression) list
+                  -> expression
+    val letmodule: ?loc:loc -> ?attrs:attrs -> str -> module_expr -> expression
+                   -> expression
     val assert_: ?loc:loc -> ?attrs:attrs -> expression -> expression
     val lazy_: ?loc:loc -> ?attrs:attrs -> expression -> expression
     val poly: ?loc:loc -> ?attrs:attrs -> expression -> core_type option -> expression
@@ -139,12 +152,23 @@ module Val:
 (** Type declarations *)
 module Type:
   sig
-    val mk: ?loc:loc -> ?attrs:attrs -> ?params:(str option * variance) list -> ?cstrs:(core_type * core_type * loc) list -> ?kind:type_kind -> ?priv:private_flag -> ?manifest:core_type -> str -> type_declaration
+    val mk: ?loc:loc -> ?attrs:attrs -> ?params:(core_type * variance) list -> ?cstrs:(core_type * core_type * loc) list -> ?kind:type_kind -> ?priv:private_flag -> ?manifest:core_type -> str -> type_declaration
 
     val constructor: ?loc:loc -> ?attrs:attrs -> ?args:constructor_arguments -> ?res:core_type -> str -> constructor_declaration
     val field: ?loc:loc -> ?attrs:attrs -> ?mut:mutable_flag -> str -> core_type -> label_declaration
   end
 
+(** Type extensions *)
+module Te:
+  sig
+    val mk: ?attrs:attrs -> ?params:(core_type * variance) list -> ?priv:private_flag -> lid -> extension_constructor list -> type_extension
+
+    val constructor: ?loc:loc -> ?attrs:attrs -> str -> extension_constructor_kind -> extension_constructor
+
+    val decl: ?loc:loc -> ?attrs:attrs -> ?args:constructor_arguments -> ?res:core_type -> str -> extension_constructor
+    val rebind: ?loc:loc -> ?attrs:attrs -> str -> lid -> extension_constructor
+  end
+
 (** {2 Module language} *)
 
 (** Module type expressions *)
@@ -186,7 +210,8 @@ module Sig:
 
     val value: ?loc:loc -> value_description -> signature_item
     val type_: ?loc:loc -> type_declaration list -> signature_item
-    val exception_: ?loc:loc -> constructor_declaration -> signature_item
+    val type_extension: ?loc:loc -> type_extension -> signature_item
+    val exception_: ?loc:loc -> extension_constructor -> signature_item
     val module_: ?loc:loc -> module_declaration -> signature_item
     val rec_module: ?loc:loc -> module_declaration list -> signature_item
     val modtype: ?loc:loc -> module_type_declaration -> signature_item
@@ -207,8 +232,8 @@ module Str:
     val value: ?loc:loc -> rec_flag -> value_binding list -> structure_item
     val primitive: ?loc:loc -> value_description -> structure_item
     val type_: ?loc:loc -> type_declaration list -> structure_item
-    val exception_: ?loc:loc -> constructor_declaration -> structure_item
-    val exn_rebind: ?loc:loc -> exception_rebind -> structure_item
+    val type_extension: ?loc:loc -> type_extension -> structure_item
+    val exception_: ?loc:loc -> extension_constructor -> structure_item
     val module_: ?loc:loc -> module_binding -> structure_item
     val rec_module: ?loc:loc -> module_binding list -> structure_item
     val modtype: ?loc:loc -> module_type_declaration -> structure_item
@@ -283,6 +308,7 @@ module Ctf:
     val method_: ?loc:loc -> ?attrs:attrs -> string -> private_flag -> virtual_flag -> core_type -> class_type_field
     val constraint_: ?loc:loc -> ?attrs:attrs -> core_type -> core_type -> class_type_field
     val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_type_field
+    val attribute: ?loc:loc -> attribute -> class_type_field
   end
 
 (** Class expressions *)
@@ -312,6 +338,7 @@ module Cf:
     val constraint_: ?loc:loc -> ?attrs:attrs -> core_type -> core_type -> class_field
     val initializer_: ?loc:loc -> ?attrs:attrs -> expression -> class_field
     val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_field
+    val attribute: ?loc:loc -> attribute -> class_field
 
     val virtual_: core_type -> class_field_kind
     val concrete: override_flag -> expression -> class_field_kind
@@ -320,7 +347,7 @@ module Cf:
 (** Classes *)
 module Ci:
   sig
-    val mk: ?loc:loc -> ?attrs:attrs -> ?virt:virtual_flag -> ?params:(str * variance) list -> str -> 'a -> 'a class_infos
+    val mk: ?loc:loc -> ?attrs:attrs -> ?virt:virtual_flag -> ?params:(core_type * variance) list -> str -> 'a -> 'a class_infos
   end
 
 (** Class signatures *)
@@ -334,77 +361,3 @@ module Cstr:
   sig
     val mk: pattern -> class_field list -> class_structure
   end
-
-(** Exception rebinding *)
-module Exrb:
-  sig
-    val mk: ?loc:loc -> ?attrs:attrs -> str -> lid -> exception_rebind
-end
-
-
-(** {2 Convenience functions} *)
-
-(** Convenience functions to help build and deconstruct AST fragments. *)
-module Convenience :
-  sig
-
-    (** {2 Misc} *)
-
-    val lid: string -> lid
-
-    (** {2 Expressions} *)
-
-    val evar: string -> expression
-    val let_in: ?recursive:bool -> value_binding list -> expression -> expression
-
-    val constr: string -> expression list -> expression
-    val record: ?over:expression -> (string * expression) list -> expression
-    val tuple: expression list -> expression
-
-    val nil: unit -> expression
-    val cons: expression -> expression -> expression
-    val list: expression list -> expression
-
-    val unit: unit -> expression
-
-    val func: (pattern * expression) list -> expression
-    val lam: ?label:string -> ?default:expression -> pattern -> expression -> expression
-    val app: expression -> expression list -> expression
-
-    val str: string -> expression
-    val int: int -> expression
-    val char: char -> expression
-    val float: float -> expression
-
-    (** {2 Patterns} *)
-
-    val pvar: string -> pattern
-    val pconstr: string -> pattern list -> pattern
-    val precord: ?closed:closed_flag -> (string * pattern) list -> pattern
-    val ptuple: pattern list -> pattern
-
-    val pnil: unit -> pattern
-    val pcons: pattern -> pattern -> pattern
-    val plist: pattern list -> pattern
-
-    val pstr: string -> pattern
-    val pint: int -> pattern
-    val pchar: char -> pattern
-    val pfloat: float -> pattern
-
-    val punit: unit -> pattern
-
-
-    (** {2 Types} *)
-
-    val tconstr: string -> core_type list -> core_type
-
-    (** {2 AST deconstruction} *)
-
-    val get_str: expression -> string option
-    val get_lid: expression -> string option
-
-    val has_attr: string -> attributes -> bool
-    val find_attr: string -> attributes -> payload option
-    val find_attr_expr: string -> attributes -> expression option
-  end
diff --git a/parsing/ast_mapper.ml b/parsing/ast_mapper.ml
index 4d05bf077f..aa6608a995 100644
--- a/parsing/ast_mapper.ml
+++ b/parsing/ast_mapper.ml
@@ -18,6 +18,8 @@
 *)
 
 
+open Asttypes
+open Longident
 open Parsetree
 open Ast_helper
 open Location
@@ -39,9 +41,10 @@ type mapper = {
   class_type_field: mapper -> class_type_field -> class_type_field;
   constructor_declaration: mapper -> constructor_declaration
                            -> constructor_declaration;
-  exception_rebind: mapper -> exception_rebind -> exception_rebind;
   expr: mapper -> expression -> expression;
   extension: mapper -> extension -> extension;
+  extension_constructor: mapper -> extension_constructor
+                         -> extension_constructor;
   include_declaration: mapper -> include_declaration -> include_declaration;
   include_description: mapper -> include_description -> include_description;
   label_declaration: mapper -> label_declaration -> label_declaration;
@@ -61,6 +64,7 @@ type mapper = {
   structure_item: mapper -> structure_item -> structure_item;
   typ: mapper -> core_type -> core_type;
   type_declaration: mapper -> type_declaration -> type_declaration;
+  type_extension: mapper -> type_extension -> type_extension;
   type_kind: mapper -> type_kind -> type_kind;
   value_binding: mapper -> value_binding -> value_binding;
   value_description: mapper -> value_description -> value_description;
@@ -79,7 +83,8 @@ module T = struct
   (* Type expressions for the core language *)
 
   let row_field sub = function
-    | Rtag (l, b, tl) -> Rtag (l, b, List.map (sub.typ sub) tl)
+    | Rtag (l, attrs, b, tl) ->
+        Rtag (l, sub.attributes sub attrs, b, List.map (sub.typ sub) tl)
     | Rinherit t -> Rinherit (sub.typ sub t)
 
   let map sub {ptyp_desc = desc; ptyp_loc = loc; ptyp_attributes = attrs} =
@@ -95,7 +100,8 @@ module T = struct
     | Ptyp_constr (lid, tl) ->
         constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl)
     | Ptyp_object (l, o) ->
-        object_ ~loc ~attrs (List.map (map_snd (sub.typ sub)) l) o
+        let f (s, a, t) = (s, sub.attributes sub a, sub.typ sub t) in
+        object_ ~loc ~attrs (List.map f l) o
     | Ptyp_class (lid, tl) ->
         class_ ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl)
     | Ptyp_alias (t, s) -> alias ~loc ~attrs (sub.typ sub t) s
@@ -115,7 +121,7 @@ module T = struct
        ptype_attributes;
        ptype_loc} =
     Type.mk (map_loc sub ptype_name)
-      ~params:(List.map (map_fst (map_opt (map_loc sub))) ptype_params)
+      ~params:(List.map (map_fst (sub.typ sub)) ptype_params)
       ~priv:ptype_private
       ~cstrs:(List.map
                 (map_tuple3 (sub.typ sub) (sub.typ sub) (sub.location sub))
@@ -130,6 +136,42 @@ module T = struct
     | Ptype_variant l ->
         Ptype_variant (List.map (sub.constructor_declaration sub) l)
     | Ptype_record l -> Ptype_record (List.map (sub.label_declaration sub) l)
+    | Ptype_open -> Ptype_open
+
+  let map_constructor_arguments sub = function
+    | Pcstr_tuple l -> Pcstr_tuple (List.map (sub.typ sub) l)
+    | Pcstr_record l ->
+        Pcstr_record (List.map (sub.label_declaration sub) l)
+
+  let map_type_extension sub
+      {ptyext_path; ptyext_params;
+       ptyext_constructors;
+       ptyext_private;
+       ptyext_attributes} =
+    Te.mk
+      (map_loc sub ptyext_path)
+      (List.map (sub.extension_constructor sub) ptyext_constructors)
+      ~params:(List.map (map_fst (sub.typ sub)) ptyext_params)
+      ~priv:ptyext_private
+      ~attrs:(sub.attributes sub ptyext_attributes)
+
+  let map_extension_constructor_kind sub = function
+      Pext_decl(ctl, cto) ->
+        Pext_decl(map_constructor_arguments sub ctl, map_opt (sub.typ sub) cto)
+    | Pext_rebind li ->
+        Pext_rebind (map_loc sub li)
+
+  let map_extension_constructor sub
+      {pext_name;
+       pext_kind;
+       pext_loc;
+       pext_attributes} =
+    Te.constructor
+      (map_loc sub pext_name)
+      (map_extension_constructor_kind sub pext_kind)
+      ~loc:(sub.location sub pext_loc)
+      ~attrs:(sub.attributes sub pext_attributes)
+
 end
 
 module CT = struct
@@ -156,6 +198,7 @@ module CT = struct
     | Pctf_method (s, p, v, t) -> method_ ~loc ~attrs s p v (sub.typ sub t)
     | Pctf_constraint (t1, t2) ->
         constraint_ ~loc ~attrs (sub.typ sub t1) (sub.typ sub t2)
+    | Pctf_attribute x -> attribute ~loc (sub.attribute sub x)
     | Pctf_extension x -> extension ~loc ~attrs (sub.extension sub x)
 
   let map_signature sub {pcsig_self; pcsig_fields} =
@@ -200,7 +243,8 @@ module MT = struct
     match desc with
     | Psig_value vd -> value ~loc (sub.value_description sub vd)
     | Psig_type l -> type_ ~loc (List.map (sub.type_declaration sub) l)
-    | Psig_exception ed -> exception_ ~loc (sub.constructor_declaration sub ed)
+    | Psig_typext te -> type_extension ~loc (sub.type_extension sub te)
+    | Psig_exception ed -> exception_ ~loc (sub.extension_constructor sub ed)
     | Psig_module x -> module_ ~loc (sub.module_declaration sub x)
     | Psig_recmodule l ->
         rec_module ~loc (List.map (sub.module_declaration sub) l)
@@ -247,8 +291,8 @@ module M = struct
     | Pstr_value (r, vbs) -> value ~loc r (List.map (sub.value_binding sub) vbs)
     | Pstr_primitive vd -> primitive ~loc (sub.value_description sub vd)
     | Pstr_type l -> type_ ~loc (List.map (sub.type_declaration sub) l)
-    | Pstr_exception ed -> exception_ ~loc (sub.constructor_declaration sub ed)
-    | Pstr_exn_rebind x -> exn_rebind ~loc (sub.exception_rebind sub x)
+    | Pstr_typext te -> type_extension ~loc (sub.type_extension sub te)
+    | Pstr_exception ed -> exception_ ~loc (sub.extension_constructor sub ed)
     | Pstr_module x -> module_ ~loc (sub.module_binding sub x)
     | Pstr_recmodule l -> rec_module ~loc (List.map (sub.module_binding sub) l)
     | Pstr_modtype x -> modtype ~loc (sub.module_type_declaration sub x)
@@ -362,6 +406,7 @@ module P = struct
     | Ppat_type s -> type_ ~loc ~attrs (map_loc sub s)
     | Ppat_lazy p -> lazy_ ~loc ~attrs (sub.pat sub p)
     | Ppat_unpack s -> unpack ~loc ~attrs (map_loc sub s)
+    | Ppat_exception p -> exception_ ~loc ~attrs (sub.pat sub p)
     | Ppat_extension x -> extension ~loc ~attrs (sub.extension sub x)
 end
 
@@ -406,6 +451,7 @@ module CE = struct
     | Pcf_constraint (t1, t2) ->
         constraint_ ~loc ~attrs (sub.typ sub t1) (sub.typ sub t2)
     | Pcf_initializer e -> initializer_ ~loc ~attrs (sub.expr sub e)
+    | Pcf_attribute x -> attribute ~loc (sub.attribute sub x)
     | Pcf_extension x -> extension ~loc ~attrs (sub.extension sub x)
 
   let map_structure sub {pcstr_self; pcstr_fields} =
@@ -417,8 +463,8 @@ module CE = struct
   let class_infos sub f {pci_virt; pci_params = pl; pci_name; pci_expr;
                          pci_loc; pci_attributes} =
     Ci.mk
-      ~virt:pci_virt
-      ~params:(List.map (map_fst (map_loc sub)) pl)
+     ~virt:pci_virt
+     ~params:(List.map (map_fst (sub.typ sub)) pl)
       (map_loc sub pci_name)
       (f pci_expr)
       ~loc:(sub.location sub pci_loc)
@@ -453,7 +499,8 @@ let default_mapper =
     type_declaration = T.map_type_declaration;
     type_kind = T.map_type_kind;
     typ = T.map;
-
+    type_extension = T.map_type_extension;
+    extension_constructor = T.map_extension_constructor;
     value_description =
       (fun this {pval_name; pval_type; pval_prim; pval_loc;
                  pval_attributes} ->
@@ -530,12 +577,7 @@ let default_mapper =
 
     constructor_declaration =
       (fun this {pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes} ->
-        let args =
-          match pcd_args with
-          | Pcstr_tuple l -> Pcstr_tuple (List.map (this.typ this) l)
-          | Pcstr_record l ->
-              Pcstr_record (List.map (this.label_declaration this) l)
-        in
+        let args = T.map_constructor_arguments this pcd_args in
         Type.constructor
           (map_loc this pcd_name)
           ~args
@@ -554,15 +596,6 @@ let default_mapper =
            ~attrs:(this.attributes this pld_attributes)
       );
 
-    exception_rebind =
-      (fun this {pexrb_name; pexrb_lid; pexrb_attributes; pexrb_loc} ->
-         Exrb.mk
-           (map_loc this pexrb_name)
-           (map_loc this pexrb_lid)
-           ~loc:(this.location this pexrb_loc)
-           ~attrs:(this.attributes this pexrb_attributes)
-      );
-
     cases = (fun this l -> List.map (this.case this) l);
     case =
       (fun this {pc_lhs; pc_guard; pc_rhs} ->
@@ -588,23 +621,134 @@ let default_mapper =
       );
   }
 
+let rec extension_of_error {loc; msg; if_highlight; sub} =
+  { loc; txt = "ocaml.error" },
+  PStr ([Str.eval (Exp.constant (Const_string (msg, None)));
+         Str.eval (Exp.constant (Const_string (if_highlight, None)))] @
+        (List.map (fun ext -> Str.extension (extension_of_error ext)) sub))
+
+let attribute_of_warning loc s =
+  { loc; txt = "ocaml.ppwarning" },
+  PStr ([Str.eval ~loc (Exp.constant (Const_string (s, None)))])
 
+let tool_name_ref = ref "_none_"
+
+let tool_name () = !tool_name_ref
+
+let restore_ppx_context payload =
+  let fields =
+    match payload with
+    | PStr [{pstr_desc = Pstr_eval
+                 ({ pexp_desc = Pexp_record (fields, None) }, [])}] ->
+        fields
+    | _ ->
+        raise_errorf "Internal error: invalid [@@@ocaml.ppx.context] syntax"
+  in
+  let field name payload =
+    let rec get_string = function
+      | { pexp_desc = Pexp_constant (Const_string (str, None)) } -> str
+      | _ ->
+          raise_errorf
+            "Internal error: invalid [@@@ocaml.ppx.context { %s }] string syntax"
+            name
+    and get_bool pexp =
+      match pexp with
+      | {pexp_desc = Pexp_construct ({txt = Longident.Lident "true"}, None)} ->
+          true
+      | {pexp_desc = Pexp_construct ({txt = Longident.Lident "false"}, None)} ->
+          false
+      | _ ->
+          raise_errorf
+            "Internal error: invalid [@@@ocaml.ppx.context { %s }] bool syntax"
+            name
+    and get_list elem = function
+      | {pexp_desc =
+           Pexp_construct ({txt = Longident.Lident "::"},
+                           Some {pexp_desc = Pexp_tuple [exp; rest]}) } ->
+          elem exp :: get_list elem rest
+      | {pexp_desc =
+           Pexp_construct ({txt = Longident.Lident "[]"}, None)} ->
+          []
+      | _ ->
+          raise_errorf
+            "Internal error: invalid [@@@ocaml.ppx.context { %s }] list syntax"
+            name
+    and get_option elem = function
+      | { pexp_desc =
+            Pexp_construct ({ txt = Longident.Lident "Some" }, Some exp) } ->
+          Some (elem exp)
+      | { pexp_desc =
+            Pexp_construct ({ txt = Longident.Lident "None" }, None) } ->
+          None
+      | _ ->
+          raise_errorf
+            "Internal error: invalid [@@@ocaml.ppx.context { %s }] option syntax"
+            name
+    in
+    match name with
+    | "tool_name" ->
+        tool_name_ref := get_string payload
+    | "include_dirs" ->
+        Clflags.include_dirs := get_list get_string payload
+    | "load_path" ->
+        Config.load_path := get_list get_string payload
+    | "open_modules" ->
+        Clflags.open_modules := get_list get_string payload
+    | "for_package" ->
+        Clflags.for_package := get_option get_string payload
+    | "debug" ->
+        Clflags.debug := get_bool payload
+    | _ ->
+        ()
+  in
+  List.iter (function ({txt=Lident name}, x) -> field name x | _ -> ()) fields
 
 let apply ~source ~target mapper =
   let ic = open_in_bin source in
-  let magic = String.create (String.length Config.ast_impl_magic_number) in
-  really_input ic magic 0 (String.length magic);
+  let magic =
+    really_input_string ic (String.length Config.ast_impl_magic_number)
+  in
   if magic <> Config.ast_impl_magic_number
   && magic <> Config.ast_intf_magic_number then
-    failwith "Ast_mapper: unknown magic number";
+    failwith "Ast_mapper: OCaml version mismatch or malformed input";
   Location.input_name := input_value ic;
   let ast = input_value ic in
   close_in ic;
 
+  let implem ast =
+    try
+      begin match ast with
+      | {pstr_desc = Pstr_attribute ({txt = "ocaml.ppx.context"}, x)} :: _ ->
+          restore_ppx_context x
+      | _ -> ()
+      end;
+      mapper.structure mapper ast
+    with exn ->
+      match error_of_exn exn with
+      | Some error ->
+          [{pstr_desc = Pstr_extension (extension_of_error error, []);
+            pstr_loc  = Location.none}]
+      | None -> raise exn
+  in
+  let iface ast =
+    try
+      begin match ast with
+      | {psig_desc = Psig_attribute ({txt = "ocaml.ppx.context"}, x)} :: _ ->
+          restore_ppx_context x
+      | _ -> ()
+      end;
+      mapper.signature mapper ast
+    with exn ->
+      match error_of_exn exn with
+      | Some error ->
+          [{psig_desc = Psig_extension (extension_of_error error, []);
+            psig_loc  = Location.none}]
+      | None -> raise exn
+  in
   let ast =
     if magic = Config.ast_impl_magic_number
-    then Obj.magic (mapper.structure mapper (Obj.magic ast))
-    else Obj.magic (mapper.signature mapper (Obj.magic ast))
+    then Obj.magic (implem (Obj.magic ast))
+    else Obj.magic (iface (Obj.magic ast))
   in
   let oc = open_out_bin target in
   output_string oc magic;
@@ -617,18 +761,57 @@ let run_main mapper =
     let a = Sys.argv in
     let n = Array.length a in
     if n > 2 then
-      apply ~source:a.(n - 2) ~target:a.(n - 1)
-            (mapper (Array.to_list (Array.sub a 1 (n - 3))))
+      let mapper =
+        try mapper (Array.to_list (Array.sub a 1 (n - 3)))
+        with exn ->
+          (* PR #6463 *)
+          let f _ _ = raise exn in
+          {default_mapper with structure = f; signature = f}
+      in
+      apply ~source:a.(n - 2) ~target:a.(n - 1) mapper
     else begin
       Printf.eprintf "Usage: %s [extra_args] <infile> <outfile>\n%!"
                      Sys.executable_name;
       exit 2
     end
   with exn ->
-    begin try Location.report_exception Format.err_formatter exn
-    with exn -> prerr_endline (Printexc.to_string exn)
-    end;
+    prerr_endline (Printexc.to_string exn);
     exit 2
 
 let register_function = ref (fun _name f -> run_main f)
 let register name f = !register_function name f
+
+
+let ppx_context ~tool_name () =
+  let open Longident in
+  let open Asttypes in
+  let open Ast_helper in
+  let lid name = { txt = Lident name; loc = Location.none } in
+  let make_string x = Exp.constant (Const_string (x, None)) in
+  let make_bool x =
+    if x
+    then Exp.construct (lid "true") None
+    else Exp.construct (lid "false") None
+  in
+  let rec make_list f lst =
+    match lst with
+    | x :: rest ->
+      Exp.construct (lid "::") (Some (Exp.tuple [f x; make_list f rest]))
+    | [] ->
+      Exp.construct (lid "[]") None
+  in
+  let make_option f opt =
+    match opt with
+    | Some x -> Exp.construct (lid "Some") (Some (f x))
+    | None   -> Exp.construct (lid "None") None
+  in
+  { txt = "ocaml.ppx.context"; loc = Location.none },
+    Parsetree.PStr [Str.eval (
+      Exp.record ([
+        lid "tool_name",    make_string tool_name;
+        lid "include_dirs", make_list make_string !Clflags.include_dirs;
+        lid "load_path",    make_list make_string !Config.load_path;
+        lid "open_modules", make_list make_string !Clflags.open_modules;
+        lid "for_package",  make_option make_string !Clflags.for_package;
+        lid "debug",        make_bool !Clflags.debug;
+      ]) None)]
diff --git a/parsing/ast_mapper.mli b/parsing/ast_mapper.mli
index f8d3311e52..786c37d6be 100644
--- a/parsing/ast_mapper.mli
+++ b/parsing/ast_mapper.mli
@@ -33,9 +33,10 @@ type mapper = {
   class_type_field: mapper -> class_type_field -> class_type_field;
   constructor_declaration: mapper -> constructor_declaration
                            -> constructor_declaration;
-  exception_rebind: mapper -> exception_rebind -> exception_rebind;
   expr: mapper -> expression -> expression;
   extension: mapper -> extension -> extension;
+  extension_constructor: mapper -> extension_constructor
+                         -> extension_constructor;
   include_declaration: mapper -> include_declaration -> include_declaration;
   include_description: mapper -> include_description -> include_description;
   label_declaration: mapper -> label_declaration -> label_declaration;
@@ -55,6 +56,7 @@ type mapper = {
   structure_item: mapper -> structure_item -> structure_item;
   typ: mapper -> core_type -> core_type;
   type_declaration: mapper -> type_declaration -> type_declaration;
+  type_extension: mapper -> type_extension -> type_extension;
   type_kind: mapper -> type_kind -> type_kind;
   value_binding: mapper -> value_binding -> value_binding;
   value_description: mapper -> value_description -> value_description;
@@ -70,6 +72,16 @@ val default_mapper: mapper
 
 (** {2 Apply mappers to compilation units} *)
 
+val tool_name: unit -> string
+(** Can be used within a ppx preprocessor to know which tool is
+    calling it ["ocamlc"], ["ocamlopt"], ["ocamldoc"], ["ocamldep"],
+    ["ocaml"], ...  Some global variables that reflect command-line
+    options are automatically synchronized between the calling tool
+    and the ppx preprocessor: [Clflags.include_dirs],
+    [Config.load_path], [Clflags.open_modules], [Clflags.for_package],
+    [Clflags.debug]. *)
+
+
 val apply: source:string -> target:string -> mapper -> unit
 (** Apply a mapper (parametrized by the unit name) to a dumped
     parsetree found in the [source] file and put the result in the
@@ -109,3 +121,21 @@ val register: string -> (string list -> mapper) -> unit
 (** {2 Convenience functions to write mappers} *)
 
 val map_opt: ('a -> 'b) -> 'a option -> 'b option
+
+val extension_of_error: Location.error -> extension
+(** Encode an error into an 'ocaml.error' extension node which can be
+    inserted in a generated Parsetree.  The compiler will be
+    responsible for reporting the error. *)
+
+val attribute_of_warning: Location.t -> string -> attribute
+(** Encode a warning message into an 'ocaml.ppwarning' attribute which can be
+    inserted in a generated Parsetree.  The compiler will be
+    responsible for reporting the warning. *)
+
+(** {2 Helper functions to call external mappers} *)
+
+val ppx_context: tool_name:string -> unit -> Parsetree.attribute
+(** Extract information from the current environment and encode it
+    into an attribute an attribute which can be prepended to
+    signature/structure items of an AST to pass the information to an
+    external processor. *)
diff --git a/parsing/lexer.mll b/parsing/lexer.mll
index 955e5dec25..237b44764c 100644
--- a/parsing/lexer.mll
+++ b/parsing/lexer.mll
@@ -94,7 +94,7 @@ let keyword_table =
 
 (* To buffer string literals *)
 
-let initial_string_buffer = String.create 256
+let initial_string_buffer = Bytes.create 256
 let string_buff = ref initial_string_buffer
 let string_index = ref 0
 
@@ -103,12 +103,12 @@ let reset_string_buffer () =
   string_index := 0
 
 let store_string_char c =
-  if !string_index >= String.length (!string_buff) then begin
-    let new_buff = String.create (String.length (!string_buff) * 2) in
-      String.blit (!string_buff) 0 new_buff 0 (String.length (!string_buff));
-      string_buff := new_buff
+  if !string_index >= Bytes.length !string_buff then begin
+    let new_buff = Bytes.create (Bytes.length (!string_buff) * 2) in
+    Bytes.blit !string_buff 0 new_buff 0 (Bytes.length !string_buff);
+    string_buff := new_buff
   end;
-  String.unsafe_set (!string_buff) (!string_index) c;
+  Bytes.unsafe_set !string_buff !string_index c;
   incr string_index
 
 let store_string s =
@@ -120,7 +120,7 @@ let store_lexeme lexbuf =
   store_string (Lexing.lexeme lexbuf)
 
 let get_stored_string () =
-  let s = String.sub (!string_buff) 0 (!string_index) in
+  let s = Bytes.sub_string !string_buff 0 !string_index in
   string_buff := initial_string_buffer;
   s
 
@@ -181,13 +181,14 @@ let cvt_nativeint_literal s =
 
 let remove_underscores s =
   let l = String.length s in
+  let b = Bytes.create l in
   let rec remove src dst =
     if src >= l then
-      if dst >= l then s else String.sub s 0 dst
+      if dst >= l then s else Bytes.sub_string b 0 dst
     else
       match s.[src] with
         '_' -> remove (src + 1) dst
-      |  c  -> s.[dst] <- c; remove (src + 1) (dst + 1)
+      |  c  -> Bytes.set b dst c; remove (src + 1) (dst + 1)
   in remove 0 0
 
 (* recover the name from a LABEL or OPTLABEL token *)
@@ -463,6 +464,7 @@ rule token = parse
   | "!=" { INFIXOP0 "!=" }
   | "+"  { PLUS }
   | "+." { PLUSDOT }
+  | "+=" { PLUSEQ }
   | "-"  { MINUS }
   | "-." { MINUSDOT }
 
diff --git a/parsing/location.ml b/parsing/location.ml
index 669f2a2433..c6d1704f15 100644
--- a/parsing/location.ml
+++ b/parsing/location.ml
@@ -83,7 +83,7 @@ let highlight_terminfo ppf num_lines lb locs =
   (* Count number of lines in phrase *)
   let lines = ref !num_loc_lines in
   for i = pos0 to lb.lex_buffer_len - 1 do
-    if lb.lex_buffer.[i] = '\n' then incr lines
+    if Bytes.get lb.lex_buffer i = '\n' then incr lines
   done;
   (* If too many lines, give up *)
   if !lines >= num_lines - 2 then raise Exit;
@@ -98,7 +98,7 @@ let highlight_terminfo ppf num_lines lb locs =
       Terminfo.standout true;
     if List.exists (fun loc -> pos = loc.loc_end.pos_cnum) locs then
       Terminfo.standout false;
-    let c = lb.lex_buffer.[pos + pos0] in
+    let c = Bytes.get lb.lex_buffer (pos + pos0) in
     print_char c;
     bol := (c = '\n')
   done;
@@ -119,7 +119,7 @@ let highlight_dumb ppf lb loc =
   (* Determine line numbers for the start and end points *)
   let line_start = ref 0 and line_end = ref 0 in
   for pos = 0 to end_pos do
-    if lb.lex_buffer.[pos + pos0] = '\n' then begin
+    if Bytes.get lb.lex_buffer (pos + pos0) = '\n' then begin
       if loc.loc_start.pos_cnum > pos then incr line_start;
       if loc.loc_end.pos_cnum   > pos then incr line_end;
     end
@@ -132,7 +132,7 @@ let highlight_dumb ppf lb loc =
   let line = ref 0 in
   let pos_at_bol = ref 0 in
   for pos = 0 to end_pos do
-    match lb.lex_buffer.[pos + pos0] with
+    match Bytes.get lb.lex_buffer (pos + pos0) with
     | '\n' ->
       if !line = !line_start && !line = !line_end then begin
         (* loc is on one line: underline location *)
@@ -367,3 +367,16 @@ let report_exception ppf exn =
   match error_of_exn exn with
   | Some err -> fprintf ppf "@[%a@]@." report_error err
   | None -> raise exn
+
+
+exception Error of error
+
+let () =
+  register_error_of_exn
+    (function
+      | Error e -> Some e
+      | _ -> None
+    )
+
+let raise_errorf ?(loc = none) ?(sub = []) ?(if_highlight = "") =
+  Printf.ksprintf (fun msg -> raise (Error ({loc; msg; sub; if_highlight})))
diff --git a/parsing/location.mli b/parsing/location.mli
index 8287d1ec9a..1a7feeb4da 100644
--- a/parsing/location.mli
+++ b/parsing/location.mli
@@ -89,11 +89,16 @@ type error =
     if_highlight: string; (* alternative message if locations are highlighted *)
   }
 
+exception Error of error
+
 val error: ?loc:t -> ?sub:error list -> ?if_highlight:string -> string -> error
 
 val errorf: ?loc:t -> ?sub:error list -> ?if_highlight:string
             -> ('a, unit, string, error) format4 -> 'a
 
+val raise_errorf: ?loc:t -> ?sub:error list -> ?if_highlight:string
+            -> ('a, unit, string, 'b) format4 -> 'a
+
 val error_of_printer: t -> (formatter -> 'a -> unit) -> 'a -> error
 
 val error_of_printer_file: (formatter -> 'a -> unit) -> 'a -> error
diff --git a/parsing/parser.mly b/parsing/parser.mly
index 172ad940ca..fa0d3c636a 100644
--- a/parsing/parser.mly
+++ b/parsing/parser.mly
@@ -237,7 +237,8 @@ let varify_constructors var_names t =
       | Ptyp_constr(longident, lst) ->
           Ptyp_constr(longident, List.map loop lst)
       | Ptyp_object (lst, o) ->
-          Ptyp_object (List.map (fun (s, t) -> (s, loop t)) lst, o)
+          Ptyp_object
+            (List.map (fun (s, attrs, t) -> (s, attrs, loop t)) lst, o)
       | Ptyp_class (longident, lst) ->
           Ptyp_class (longident, List.map loop lst)
       | Ptyp_alias(core_type, string) ->
@@ -257,8 +258,8 @@ let varify_constructors var_names t =
     {t with ptyp_desc = desc}
   and loop_row_field  =
     function
-      | Rtag(label,flag,lst) ->
-          Rtag(label,flag,List.map loop lst)
+      | Rtag(label,attrs,flag,lst) ->
+          Rtag(label,attrs,flag,List.map loop lst)
       | Rinherit t ->
           Rinherit (loop t)
   in
@@ -282,6 +283,12 @@ let wrap_exp_attrs body (ext, attrs) =
 let mkexp_attrs d attrs =
   wrap_exp_attrs (mkexp d) attrs
 
+let mkcf_attrs d attrs =
+  Cf.mk ~loc:(symbol_rloc()) ~attrs d
+
+let mkctf_attrs d attrs =
+  Ctf.mk ~loc:(symbol_rloc()) ~attrs d
+
 %}
 
 /* Tokens */
@@ -374,6 +381,7 @@ let mkexp_attrs d attrs =
 %token PERCENT
 %token PLUS
 %token PLUSDOT
+%token PLUSEQ
 %token <string> PREFIXOP
 %token PRIVATE
 %token QUESTION
@@ -453,10 +461,8 @@ The precedences must be listed from low to high.
 %nonassoc below_LBRACKETAT
 %nonassoc LBRACKETAT
 %nonassoc LBRACKETATAT
-%nonassoc LBRACKETPERCENT
-%nonassoc LBRACKETPERCENTPERCENT
 %right    COLONCOLON                    /* expr (e :: e :: e) */
-%left     INFIXOP2 PLUS PLUSDOT MINUS MINUSDOT  /* expr (e OP e OP e) */
+%left     INFIXOP2 PLUS PLUSDOT MINUS MINUSDOT PLUSEQ /* expr (e OP e OP e) */
 %left     PERCENT INFIXOP3 STAR                 /* expr (e OP e OP e) */
 %right    INFIXOP4                      /* expr (e OP e OP e) */
 %nonassoc prec_unary_minus prec_unary_plus /* unary - */
@@ -470,6 +476,7 @@ The precedences must be listed from low to high.
 %nonassoc BACKQUOTE BANG BEGIN CHAR FALSE FLOAT INT INT32 INT64
           LBRACE LBRACELESS LBRACKET LBRACKETBAR LIDENT LPAREN
           NEW NATIVEINT PREFIXOP STRING TRUE UIDENT
+          LBRACKETPERCENT LBRACKETPERCENTPERCENT
 
 
 /* Entry points */
@@ -522,9 +529,9 @@ use_file_tail:
   | SEMISEMI seq_expr post_item_attributes use_file_tail
                                               { Ptop_def[mkstrexp $2 $3] :: $4 }
   | SEMISEMI structure_item use_file_tail     { Ptop_def[$2] :: $3 }
-  | SEMISEMI toplevel_directive SEMISEMI use_file_tail { $2 :: $4 }
+  | SEMISEMI toplevel_directive use_file_tail { $2 :: $3 }
   | structure_item use_file_tail              { Ptop_def[$1] :: $2 }
-  | toplevel_directive SEMISEMI use_file_tail          { $1 :: $3 }
+  | toplevel_directive use_file_tail          { $1 :: $2 }
 ;
 parse_core_type:
     core_type EOF { $1 }
@@ -637,12 +644,10 @@ structure_item:
                              ~prim:$6 ~attrs:$7 ~loc:(symbol_rloc ()))) }
   | TYPE type_declarations
       { mkstr(Pstr_type (List.rev $2) ) }
-  | EXCEPTION exception_declaration
+  | TYPE str_type_extension
+      { mkstr(Pstr_typext $2) }
+  | EXCEPTION str_exception_declaration
       { mkstr(Pstr_exception $2) }
-  | EXCEPTION UIDENT EQUAL constr_longident post_item_attributes
-      { mkstr (Pstr_exn_rebind
-                 (Exrb.mk (mkrhs $2 2)
-                    (mkloc $4 (rhs_loc 4)) ~attrs:$5 ~loc:(symbol_rloc()))) }
   | MODULE module_binding
       { mkstr(Pstr_module $2) }
   | MODULE REC module_bindings
@@ -726,7 +731,9 @@ signature_item:
                    ~loc:(symbol_rloc()))) }
   | TYPE type_declarations
       { mksig(Psig_type (List.rev $2)) }
-  | EXCEPTION exception_declaration
+  | TYPE sig_type_extension
+      { mksig(Psig_typext $2) }
+  | EXCEPTION sig_exception_declaration
       { mksig(Psig_exception $2) }
   | MODULE UIDENT module_declaration post_item_attributes
       { mksig(Psig_module (Md.mk (mkrhs $2 2)
@@ -864,19 +871,20 @@ class_fields:
       { $2 :: $1 }
 ;
 class_field:
-  | INHERIT override_flag class_expr parent_binder
-      { mkcf (Pcf_inherit ($2, $3, $4)) }
-  | VAL value
-      { mkcf (Pcf_val $2) }
-  | METHOD method_
-      { mkcf (Pcf_method $2) }
-  | CONSTRAINT constrain_field
-      { mkcf (Pcf_constraint $2) }
-  | INITIALIZER seq_expr
-      { mkcf (Pcf_initializer $2) }
-  | class_field post_item_attribute
-      { Cf.attr $1 $2 }
-  | item_extension { mkcf(Pcf_extension $1) }
+  | INHERIT override_flag class_expr parent_binder post_item_attributes
+      { mkcf_attrs (Pcf_inherit ($2, $3, $4)) $5 }
+  | VAL value post_item_attributes
+      { mkcf_attrs (Pcf_val $2) $3 }
+  | METHOD method_ post_item_attributes
+      { mkcf_attrs (Pcf_method $2) $3 }
+  | CONSTRAINT constrain_field post_item_attributes
+      { mkcf_attrs (Pcf_constraint $2) $3 }
+  | INITIALIZER seq_expr post_item_attributes
+      { mkcf_attrs (Pcf_initializer $2) $3 }
+  | item_extension post_item_attributes
+      { mkcf_attrs (Pcf_extension $1) $2 }
+  | floating_attribute
+      { mkcf (Pcf_attribute $1) }
 ;
 parent_binder:
     AS LIDENT
@@ -964,16 +972,21 @@ class_sig_fields:
 | class_sig_fields class_sig_field     { $2 :: $1 }
 ;
 class_sig_field:
-    INHERIT class_signature       { mkctf (Pctf_inherit $2) }
-  | VAL value_type              { mkctf (Pctf_val $2) }
-  | METHOD private_virtual_flags label COLON poly_type
+    INHERIT class_signature post_item_attributes
+      { mkctf_attrs (Pctf_inherit $2) $3 }
+  | VAL value_type post_item_attributes
+      { mkctf_attrs (Pctf_val $2) $3 }
+  | METHOD private_virtual_flags label COLON poly_type post_item_attributes
       {
        let (p, v) = $2 in
-       mkctf (Pctf_method ($3, p, v, $5))
+       mkctf_attrs (Pctf_method ($3, p, v, $5)) $6
       }
-  | CONSTRAINT constrain_field        { mkctf (Pctf_constraint $2) }
-  | class_sig_field post_item_attribute { Ctf.attr $1 $2 }
-  | item_extension { mkctf(Pctf_extension $1) }
+  | CONSTRAINT constrain_field post_item_attributes
+      { mkctf_attrs (Pctf_constraint $2) $3 }
+  | item_extension post_item_attributes
+      { mkctf_attrs (Pctf_extension $1) $2 }
+  | floating_attribute
+      { mkctf(Pctf_attribute $1) }
 ;
 value_type:
     VIRTUAL mutable_flag label COLON core_type
@@ -1121,6 +1134,8 @@ expr:
       { mkinfix $1 "+" $3 }
   | expr PLUSDOT expr
       { mkinfix $1 "+." $3 }
+  | expr PLUSEQ expr
+      { mkinfix $1 "+=" $3 }
   | expr MINUS expr
       { mkinfix $1 "-" $3 }
   | expr MINUSDOT expr
@@ -1432,6 +1447,8 @@ pattern:
       { expecting 3 "pattern" }
   | LAZY simple_pattern
       { mkpat(Ppat_lazy $2) }
+  | EXCEPTION pattern %prec prec_constr_appl
+      { mkpat(Ppat_exception $2) }
   | pattern attribute
       { Pat.attr $1 $2 }
 ;
@@ -1550,27 +1567,33 @@ type_kind:
       { (Ptype_variant(List.rev $3), Private, None) }
   | EQUAL private_flag BAR constructor_declarations
       { (Ptype_variant(List.rev $4), $2, None) }
+  | EQUAL DOTDOT
+      { (Ptype_open, Public, None) }
   | EQUAL private_flag LBRACE label_declarations opt_semi RBRACE
       { (Ptype_record(List.rev $4), $2, None) }
   | EQUAL core_type EQUAL private_flag opt_bar constructor_declarations
       { (Ptype_variant(List.rev $6), $4, Some $2) }
+  | EQUAL core_type EQUAL DOTDOT
+      { (Ptype_open, Public, Some $2) }
   | EQUAL core_type EQUAL private_flag LBRACE label_declarations opt_semi RBRACE
       { (Ptype_record(List.rev $6), $4, Some $2) }
 ;
 optional_type_parameters:
     /*empty*/                                   { [] }
-  | optional_type_parameter                              { [$1] }
+  | optional_type_parameter                     { [$1] }
   | LPAREN optional_type_parameter_list RPAREN  { List.rev $2 }
 ;
 optional_type_parameter:
-    type_variance QUOTE ident                   { Some (mkrhs $3 3), $1 }
-  | type_variance UNDERSCORE                    { None, $1 }
+    type_variance optional_type_variable        { $2, $1 }
 ;
 optional_type_parameter_list:
     optional_type_parameter                              { [$1] }
   | optional_type_parameter_list COMMA optional_type_parameter    { $3 :: $1 }
 ;
-
+optional_type_variable:
+    QUOTE ident                                 { mktyp(Ptyp_var $2) }
+  | UNDERSCORE                                  { mktyp(Ptyp_any) }
+;
 
 
 type_parameters:
@@ -1579,13 +1602,16 @@ type_parameters:
   | LPAREN type_parameter_list RPAREN           { List.rev $2 }
 ;
 type_parameter:
-    type_variance QUOTE ident                   { mkrhs $3 3, $1 }
+    type_variance type_variable                   { $2, $1 }
 ;
 type_variance:
     /* empty */                                 { Invariant }
   | PLUS                                        { Covariant }
   | MINUS                                       { Contravariant }
 ;
+type_variable:
+    QUOTE ident                                 { mktyp(Ptyp_var $2) }
+;
 type_parameter_list:
     type_parameter                              { [$1] }
   | type_parameter_list COMMA type_parameter    { $3 :: $1 }
@@ -1601,11 +1627,23 @@ constructor_declaration:
        Type.constructor (mkrhs $1 1) ~args ?res ~loc:(symbol_rloc()) ~attrs:$2
       }
 ;
-exception_declaration:
-  | constructor_declaration post_item_attributes
+str_exception_declaration:
+  | extension_constructor_declaration post_item_attributes
+      {
+        let ext = $1 in
+        {ext with pext_attributes = ext.pext_attributes @ $2}
+      }
+  | extension_constructor_rebind post_item_attributes
+      {
+        let ext = $1 in
+        {ext with pext_attributes = ext.pext_attributes @ $2}
+      }
+;
+sig_exception_declaration:
+  | extension_constructor_declaration post_item_attributes
       {
-        let cd = $1 in
-        {cd with pcd_attributes = cd.pcd_attributes @ $2}
+        let ext = $1 in
+        {ext with pext_attributes = ext.pext_attributes @ $2}
       }
 ;
 generalized_constructor_arguments:
@@ -1632,6 +1670,43 @@ label_declaration:
       }
 ;
 
+/* Type Extensions */
+
+str_type_extension:
+  optional_type_parameters type_longident
+  PLUSEQ private_flag opt_bar str_extension_constructors post_item_attributes
+      { Te.mk (mkrhs $2 2) (List.rev $6)
+          ~params:$1 ~priv:$4 ~attrs:$7 }
+;
+sig_type_extension:
+  optional_type_parameters type_longident
+  PLUSEQ private_flag opt_bar sig_extension_constructors post_item_attributes
+      { Te.mk (mkrhs $2 2) (List.rev $6)
+          ~params:$1 ~priv:$4 ~attrs:$7 }
+;
+str_extension_constructors:
+    extension_constructor_declaration                     { [$1] }
+  | extension_constructor_rebind                          { [$1] }
+  | str_extension_constructors BAR extension_constructor_declaration
+      { $3 :: $1 }
+  | str_extension_constructors BAR extension_constructor_rebind
+      { $3 :: $1 }
+;
+sig_extension_constructors:
+    extension_constructor_declaration                     { [$1] }
+  | sig_extension_constructors BAR extension_constructor_declaration
+      { $3 :: $1 }
+;
+extension_constructor_declaration:
+  | constr_ident attributes generalized_constructor_arguments
+      { let args, res = $3 in
+        Te.decl (mkrhs $1 1) ~args ?res ~loc:(symbol_rloc()) ~attrs:$2 }
+;
+extension_constructor_rebind:
+  | constr_ident attributes EQUAL constr_longident
+      { Te.rebind (mkrhs $1 1) (mkrhs $4 4) ~loc:(symbol_rloc()) ~attrs:$2 }
+;
+
 /* "with" constraints (additional type equations over signature components) */
 
 with_constraints:
@@ -1643,7 +1718,7 @@ with_constraint:
       { Pwith_type
           (mkrhs $3 3,
            (Type.mk (mkrhs (Longident.last $3) 3)
-              ~params:(List.map (fun (x, v) -> Some x, v) $2)
+              ~params:$2
               ~cstrs:(List.rev $6)
               ~manifest:$5
               ~priv:$4
@@ -1653,7 +1728,7 @@ with_constraint:
   | TYPE type_parameters label COLONEQUAL core_type
       { Pwith_typesubst
           (Type.mk (mkrhs $3 3)
-             ~params:(List.map (fun (x, v) -> Some x, v) $2)
+             ~params:$2
              ~manifest:$5
              ~loc:(symbol_rloc())) }
   | MODULE mod_longident EQUAL mod_ext_longident
@@ -1780,10 +1855,10 @@ row_field:
   | simple_core_type                            { Rinherit $1 }
 ;
 tag_field:
-    name_tag OF opt_ampersand amper_type_list
-      { Rtag ($1, $3, List.rev $4) }
-  | name_tag
-      { Rtag ($1, true, []) }
+    name_tag attributes OF opt_ampersand amper_type_list
+      { Rtag ($1, $2, $4, List.rev $5) }
+  | name_tag attributes
+      { Rtag ($1, $2, true, []) }
 ;
 opt_ampersand:
     AMPERSAND                                   { true }
@@ -1826,7 +1901,7 @@ meth_list:
   | DOTDOT                                      { [], Open }
 ;
 field:
-    label COLON poly_type /* ok */              { ($1, $3) }
+    label attributes COLON poly_type            { ($1, $2, $4) }
 ;
 label:
     LIDENT                                      { $1 }
@@ -1891,6 +1966,7 @@ operator:
   | AMPERSAND                                   { "&" }
   | AMPERAMPER                                  { "&&" }
   | COLONEQUAL                                  { ":=" }
+  | PLUSEQ                                      { "+=" }
   | PERCENT                                     { "%" }
 ;
 constr_ident:
@@ -1951,23 +2027,15 @@ class_longident:
 /* Toplevel directives */
 
 toplevel_directive:
-    SHARP ident toplevel_directive_args    { Ptop_dir($2, $3) }
-;
-toplevel_directive_arg:
-  | STRING          { Pdir_string (fst $1) }
-  | INT             { Pdir_int $1 }
-  | val_longident   { Pdir_ident $1 }
-  | mod_longident   { Pdir_ident $1 }
-  | keyword         {
-    match $1 with
-    | "true" -> Pdir_bool true
-    | "false" -> Pdir_bool false
-    | s -> Pdir_keyword s
-  }
-toplevel_directive_args:
-  | /*empty*/ { [] }
-  | toplevel_directive_arg toplevel_directive_args { $1 :: $2 }
+    SHARP ident                 { Ptop_dir($2, Pdir_none) }
+  | SHARP ident STRING          { Ptop_dir($2, Pdir_string (fst $3)) }
+  | SHARP ident INT             { Ptop_dir($2, Pdir_int $3) }
+  | SHARP ident val_longident   { Ptop_dir($2, Pdir_ident $3) }
+  | SHARP ident mod_longident   { Ptop_dir($2, Pdir_ident $3) }
+  | SHARP ident FALSE           { Ptop_dir($2, Pdir_bool false) }
+  | SHARP ident TRUE            { Ptop_dir($2, Pdir_bool true) }
 ;
+
 /* Miscellaneous */
 
 name_tag:
@@ -2023,7 +2091,9 @@ additive:
 
 /* Attributes and extensions */
 
-keyword:
+single_attr_id:
+    LIDENT { $1 }
+  | UIDENT { $1 }
   | AND { "and" }
   | AS { "as" }
   | ASSERT { "assert" }
@@ -2074,11 +2144,6 @@ keyword:
   | WITH { "with" }
 /* mod/land/lor/lxor/lsl/lsr/asr are not supported for now */
 ;
-single_attr_id:
-    LIDENT { $1 }
-  | UIDENT { $1 }
-  | keyword { $1 }
-;
 
 attr_id:
     single_attr_id { mkloc $1 (symbol_rloc()) }
diff --git a/parsing/parsetree.mli b/parsing/parsetree.mli
index a984c7800d..75b8528c65 100644
--- a/parsing/parsetree.mli
+++ b/parsing/parsetree.mli
@@ -66,7 +66,7 @@ and core_type_desc =
            T tconstr
            (T1, ..., Tn) tconstr
          *)
-  | Ptyp_object of (string * core_type) list * closed_flag
+  | Ptyp_object of (string * attributes * core_type) list * closed_flag
         (* < l1:T1; ...; ln:Tn >     (flag = Closed)
            < l1:T1; ...; ln:Tn; .. > (flag = Open)
          *)
@@ -115,7 +115,7 @@ and package_type = Longident.t loc * (Longident.t loc * core_type) list
        *)
 
 and row_field =
-  | Rtag of label * bool * core_type list
+  | Rtag of label * attributes * bool * core_type list
         (* [`A]                   ( true,  [] )
            [`A of T]              ( false, [T] )
            [`A of T1 & .. & Tn]   ( false, [T1;...Tn] )
@@ -125,6 +125,8 @@ and row_field =
             constant (empty) constructor.
           - '&' occurs when several types are used for the same constructor
             (see 4.2 in the manual)
+
+          - TODO: switch to a record representation, and keep location
         *)
   | Rinherit of core_type
         (* [ T ] *)
@@ -182,6 +184,8 @@ and pattern_desc =
            Note: (module P : S) is represented as
            Ppat_constraint(Ppat_unpack, Ptyp_package)
          *)
+  | Ppat_exception of pattern
+        (* exception P *)
   | Ppat_extension of extension
         (* [%id] *)
 
@@ -332,7 +336,7 @@ and value_description =
 and type_declaration =
     {
      ptype_name: string loc;
-     ptype_params: (string loc option * variance) list;
+     ptype_params: (core_type * variance) list;
            (* ('a1,...'an) t; None represents  _*)
      ptype_cstrs: (core_type * core_type * Location.t) list;
            (* ... constraint T1=T1'  ... constraint Tn=Tn' *)
@@ -350,12 +354,14 @@ and type_declaration =
   type t = T0 = C of T | ... (variant,  manifest=T0)
   type t = {l: T; ...}       (record,   no manifest)
   type t = T0 = {l : T; ...} (record,   manifest=T0)
+  type t = ..                (open,     no manifest)
 *)
 
 and type_kind =
   | Ptype_abstract
   | Ptype_variant of constructor_declaration list
   | Ptype_record of label_declaration list
+  | Ptype_open
 
 and label_declaration =
     {
@@ -394,14 +400,37 @@ and constructor_arguments =
   | C of {...} as t        (res = None,    args = Pcstr_record)
 *)
 
-and exception_rebind =
+and type_extension =
     {
-     pexrb_name: string loc;
-     pexrb_lid: Longident.t loc;
-     pexrb_loc: Location.t;
-     pexrb_attributes: attributes;
+     ptyext_path: Longident.t loc;
+     ptyext_params: (core_type * variance) list;
+     ptyext_constructors: extension_constructor list;
+     ptyext_private: private_flag;
+     ptyext_attributes: attributes;   (* ... [@@id1] [@@id2] *)
     }
-(* exception C = M.X *)
+(*
+  type t += ...
+*)
+
+and extension_constructor =
+    {
+     pext_name: string loc;
+     pext_kind : extension_constructor_kind;
+     pext_loc : Location.t;
+     pext_attributes: attributes; (* C [@id1] [@id2] of ... *)
+    }
+
+and extension_constructor_kind =
+    Pext_decl of constructor_arguments * core_type option
+      (*
+         | C of T1 * ... * Tn     ([T1; ...; Tn], None)
+         | C: T0                  ([], Some T0)
+         | C: T1 * ... * Tn -> T0 ([T1; ...; Tn], Some T0)
+       *)
+  | Pext_rebind of Longident.t loc
+      (*
+         | C = D
+       *)
 
 (** {2 Class language} *)
 
@@ -456,13 +485,15 @@ and class_type_field_desc =
          *)
   | Pctf_constraint  of (core_type * core_type)
         (* constraint T1 = T2 *)
+  | Pctf_attribute of attribute
+        (* [@@@id] *)
   | Pctf_extension of extension
         (* [%%id] *)
 
 and 'a class_infos =
     {
      pci_virt: virtual_flag;
-     pci_params: (string loc * variance) list;
+     pci_params: (core_type * variance) list;
      pci_name: string loc;
      pci_expr: 'a;
      pci_loc: Location.t;
@@ -549,6 +580,8 @@ and class_field_desc =
         (* constraint T1 = T2 *)
   | Pcf_initializer of expression
         (* initializer E *)
+  | Pcf_attribute of attribute
+        (* [@@@id] *)
   | Pcf_extension of extension
         (* [%%id] *)
 
@@ -601,7 +634,9 @@ and signature_item_desc =
          *)
   | Psig_type of type_declaration list
         (* type t1 = ... and ... and tn = ... *)
-  | Psig_exception of constructor_declaration
+  | Psig_typext of type_extension
+        (* type t1 += ... *)
+  | Psig_exception of extension_constructor
         (* exception C of T *)
   | Psig_module of module_declaration
         (* module X : MT *)
@@ -725,10 +760,11 @@ and structure_item_desc =
         (* external x: T = "s1" ... "sn" *)
   | Pstr_type of type_declaration list
         (* type t1 = ... and ... and tn = ... *)
-  | Pstr_exception of constructor_declaration
-        (* exception C of T *)
-  | Pstr_exn_rebind of exception_rebind
-        (* exception C = M.X *)
+  | Pstr_typext of type_extension
+        (* type t1 += ... *)
+  | Pstr_exception of extension_constructor
+        (* exception C of T
+           exception C = M.X *)
   | Pstr_module of module_binding
         (* module X = ME *)
   | Pstr_recmodule of module_binding list
@@ -771,12 +807,12 @@ and module_binding =
 
 type toplevel_phrase =
   | Ptop_def of structure
-  | Ptop_dir of string * directive_argument list
+  | Ptop_dir of string * directive_argument
      (* #use, #load ... *)
 
 and directive_argument =
+  | Pdir_none
   | Pdir_string of string
   | Pdir_int of int
   | Pdir_ident of Longident.t
   | Pdir_bool of bool
-  | Pdir_keyword of string
diff --git a/parsing/pprintast.ml b/parsing/pprintast.ml
index 7e2a6428d7..3fb3494b3d 100644
--- a/parsing/pprintast.ml
+++ b/parsing/pprintast.ml
@@ -76,8 +76,8 @@ let protect_ident ppf txt =
 let protect_longident ppf print_longident longprefix txt =
   let format : (_, _, _) format =
     if not (needs_parens txt) then "%a.%s"
-    else if needs_spaces txt then  "(@;%a.%s@;)"
-    else "(%a.%s)" in
+    else if needs_spaces txt then  "%a.(@;%s@;)"
+    else "%a.(%s)" in
   fprintf ppf format print_longident longprefix txt
 
 type space_formatter = (unit, Format.formatter, unit) format
@@ -126,19 +126,6 @@ let is_simple_construct :construct -> bool = function
 
 let pp = fprintf
 
-let rec is_irrefut_patt x =
-  match x.ppat_desc with
-  | Ppat_any | Ppat_var _ | Ppat_unpack _ -> true
-  | Ppat_alias (p,_) -> is_irrefut_patt p
-  | Ppat_tuple (ps) -> List.for_all is_irrefut_patt ps
-  | Ppat_constraint (p,_) -> is_irrefut_patt p
-  | Ppat_or (l,r) -> is_irrefut_patt l || is_irrefut_patt r
-  | Ppat_record (ls,_) -> List.for_all (fun (_,x) -> is_irrefut_patt x) ls
-  | Ppat_lazy p -> is_irrefut_patt p
-  | Ppat_extension _ -> assert false
-  | Ppat_interval _
-  | Ppat_constant _ | Ppat_construct _  | Ppat_variant _ | Ppat_array _
-  | Ppat_type _-> false (*conservative*)
 class printer  ()= object(self:'self)
   val pipe = false
   val semi = false
@@ -163,9 +150,9 @@ class printer  ()= object(self:'self)
             | xs ->
                 let rec loop  f = function
                   | [x] -> fu f x
-                  | x::xs ->  pp f "%a%(%)%a" fu x sep loop xs
+                  | x::xs ->  fu f x; pp f sep; loop f xs;
                   | _ -> assert false in begin
-                      pp f "%(%)%a%(%)" first loop xs last;
+                      pp f first; loop f xs; pp f last;
                   end in
           aux f xs
   method option : 'a. ?first:space_formatter -> ?last:space_formatter ->
@@ -175,11 +162,11 @@ class printer  ()= object(self:'self)
         and last = match last with Some x -> x | None -> "" in
         match a with
         | None -> ()
-        | Some x -> pp f "%(%)%a%(%)" first fu x last
+        | Some x -> pp f first; fu f x; pp f last;
   method paren: 'a . ?first:space_formatter -> ?last:space_formatter ->
     bool -> (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a -> unit =
     fun  ?(first="") ?(last="") b fu f x ->
-      if b then pp f "(%(%)%a%(%))" first fu  x last
+      if b then (pp f "("; pp f first; fu f x; pp f last; pp f ")")
       else fu f x
 
 
@@ -223,18 +210,13 @@ class printer  ()= object(self:'self)
   method constant_string f s = pp f "%S" s
   method tyvar f str = pp f "'%s" str
   method string_quot f x = pp f "`%s" x
-  method type_var_option f str =
-    match str with
-    | None -> pp f "_" (* wildcard*)
-    | Some {txt;_} -> self#tyvar f txt
 
           (* c ['a,'b] *)
   method class_params_def f =  function
     | [] -> ()
     | l ->
         pp f "[%a] " (* space *)
-          (self#list (fun f ({txt;_},s) ->
-            pp f "%s%a" (type_variance s) self#tyvar txt) ~sep:",") l
+          (self#list self#type_param ~sep:",") l
 
   method type_with_label f (label,({ptyp_desc;_}as c) ) =
     match label with
@@ -286,7 +268,7 @@ class printer  ()= object(self:'self)
     | Ptyp_variant (l, closed, low) ->
         let type_variant_helper f x =
           match x with
-          | Rtag (l, _, ctl) -> pp f "@[<2>%a%a@]"  self#string_quot l
+          | Rtag (l, _attrs, _, ctl) -> pp f "@[<2>%a%a@]"  self#string_quot l
                 (fun f l -> match l with
                 |[] -> ()
                 | _ -> pp f "@;of@;%a"
@@ -312,7 +294,7 @@ class printer  ()= object(self:'self)
               pp f ">@ %a"
                 (self#list self#string_quot) xs) low
     | Ptyp_object (l, o) ->
-        let core_field_type f (s, ct) =
+        let core_field_type f (s, _attrs, ct) =
           pp f "@[<hov2>%s@ :%a@ @]" s self#core_type ct
         in
         let field_var f = function
@@ -412,6 +394,8 @@ class printer  ()= object(self:'self)
         pp f "@[<2>(%a@;:@;%a)@]" self#pattern1 p self#core_type ct
     | Ppat_lazy p ->
         pp f "@[<2>(lazy@;%a)@]" self#pattern1 p
+    | Ppat_exception p ->
+        pp f "@[<2>exception@;%a@]" self#pattern1 p
     | _ -> self#paren true self#pattern f x
 
   method label_exp f (l,opt,p) =
@@ -708,13 +692,8 @@ class printer  ()= object(self:'self)
         end) x
 
 
-  method exception_declaration f cd =
-    pp f "@[<hov2>exception@ %s%a@]" cd.pcd_name.txt
-      (fun f ed -> match ed with
-      | Pcstr_tuple [] -> ()
-      | Pcstr_tuple l -> pp f "@ of@ %a" (self#list ~sep:"*" self#core_type) l
-      | Pcstr_record _ -> assert false (* TODO *)
-      ) cd.pcd_args
+  method exception_declaration f ext =
+    pp f "@[<hov2>exception@ %a@]" self#extension_constructor ext
 
   method class_signature f { pcsig_self = ct; pcsig_fields = l ;_} =
     let class_type_field f x =
@@ -730,6 +709,7 @@ class printer  ()= object(self:'self)
       | Pctf_constraint (ct1, ct2) ->
           pp f "@[<2>constraint@ %a@ =@ %a@]"
             self#core_type ct1 self#core_type ct2
+      | Pctf_attribute _ -> ()
       | Pctf_extension _ -> assert false
     in
     pp f "@[<hv0>@[<hv2>object @[<1>%a@]@ %a@]@ end@]"
@@ -804,6 +784,7 @@ class printer  ()= object(self:'self)
         pp f "@[<2>constraint %a =@;%a@]" self#core_type  ct1 self#core_type  ct2
     | Pcf_initializer (e) ->
         pp f "@[<2>initializer@ %a@]" self#expression e
+    | Pcf_attribute _ -> ()
     | Pcf_extension _ -> assert false
 
   method class_structure f { pcstr_self = p; pcstr_fields =  l } =
@@ -858,14 +839,14 @@ class printer  ()= object(self:'self)
           | Pwith_type (li, ({ptype_params= ls ;_} as td)) ->
               let ls = List.map fst ls in
               pp f "type@ %a %a =@ %a"
-                (self#list self#type_var_option ~sep:"," ~first:"(" ~last:")")
+                (self#list self#core_type ~sep:"," ~first:"(" ~last:")")
                 ls self#longident_loc li  self#type_declaration  td
           | Pwith_module (li, li2) ->
               pp f "module %a =@ %a" self#longident_loc li self#longident_loc li2;
           | Pwith_typesubst ({ptype_params=ls;_} as td) ->
               let ls = List.map fst ls in
               pp f "type@ %a %s :=@ %a"
-                (self#list self#type_var_option ~sep:"," ~first:"(" ~last:")")
+                (self#list self#core_type ~sep:"," ~first:"(" ~last:")")
                 ls td.ptype_name.txt
                 self#type_declaration  td
           | Pwith_modsubst (s, li2) ->
@@ -891,6 +872,8 @@ class printer  ()= object(self:'self)
             let intro = if vd.pval_prim = [] then "val" else "external" in
             pp f "%s@ %a@ :@ " intro protect_ident vd.pval_name.txt;
             self#value_description f vd;) vd
+    | Psig_typext te ->
+        self#type_extension f te
     | Psig_exception ed ->
         self#exception_declaration f ed
     | Psig_class l ->
@@ -1043,6 +1026,7 @@ class printer  ()= object(self:'self)
     | Pstr_type l  -> self#type_def_list f l
     | Pstr_value (rf, l) -> (* pp f "@[<hov2>let %a%a@]"  self#rec_flag rf self#bindings l *)
         pp f "@[<2>%a@]" self#bindings (rf,l)
+    | Pstr_typext te -> self#type_extension f te
     | Pstr_exception ed -> self#exception_declaration f ed
     | Pstr_module x ->
         let rec module_helper me = match me.pmod_desc with
@@ -1117,10 +1101,6 @@ class printer  ()= object(self:'self)
           self#value_description  vd
     | Pstr_include incl ->
         pp f "@[<hov2>include@ %a@]"  self#module_expr  incl.pincl_mod
-    | Pstr_exn_rebind er ->        (* todo: check this *)
-        pp f "@[<hov2>exception@ %s@ =@ %a@]"
-           er.pexrb_name.txt
-           self#longident_loc er.pexrb_lid
     | Pstr_recmodule decls -> (* 3.07 *)
         let aux f = function
           | {pmb_name = s; pmb_expr={pmod_desc=Pmod_constraint (expr, typ)}} ->
@@ -1140,8 +1120,8 @@ class printer  ()= object(self:'self)
     | Pstr_attribute _ -> ()
     | Pstr_extension _ -> assert false
   end
-  method type_param f (opt, a) =
-    pp f "%s%a" (type_variance a ) self#type_var_option opt
+  method type_param f (ct, a) =
+    pp f "%s%a" (type_variance a) self#core_type ct
           (* shared by [Pstr_type,Psig_type]*)
   method  type_def_list f  l =
     let aux f ({ptype_name = s; ptype_params;ptype_kind;ptype_manifest;_} as td) =
@@ -1201,6 +1181,8 @@ class printer  ()= object(self:'self)
             pp f "@[<2>%a%s:@;%a@]" self#mutable_flag pld.pld_mutable pld.pld_name.txt self#core_type pld.pld_type in
           pp f "{@\n%a}"
             (self#list type_record_field ~sep:";@\n" )  l ;
+      | Ptype_open ->
+          pp f ".."
       ) x
       (self#list
          (fun f (ct1,ct2,_) ->
@@ -1208,6 +1190,46 @@ class printer  ()= object(self:'self)
              self#core_type ct1 self#core_type ct2 ))  x.ptype_cstrs  ;
       (* TODO: attributes *)
   end
+
+  method type_extension f x =
+    let extension_constructor f x =
+      pp f "@\n|@;%a" self#extension_constructor x
+    in
+      pp f "@[<2>type %a%a +=@;%a@]"
+         (fun f -> function
+                | [] -> ()
+                | l ->  pp f "%a@;" (self#list self#type_param ~first:"(" ~last:")" ~sep:",") l)
+         x.ptyext_params
+         self#longident_loc x.ptyext_path
+         (self#list ~sep:"" extension_constructor)
+         x.ptyext_constructors
+
+  method extension_constructor f x =
+    match x.pext_kind with
+    | Pext_decl(l, None) ->
+        pp f "%s%a" x.pext_name.txt
+          (fun f -> function
+                 | Pcstr_tuple [] -> ()
+                 | Pcstr_tuple l ->
+                     pp f "@;of@;%a" (self#list self#core_type1 ~sep:"*@;") l
+                 | Pcstr_record _ ->
+                     pp f "{...}" (* #5528: TODO *)
+          ) l
+    | Pext_decl(l, Some r) ->
+        pp f "%s:@;%a" x.pext_name.txt
+          (fun f -> function
+                 | Pcstr_tuple [] -> self#core_type1 f r
+                 | Pcstr_tuple l -> pp f "%a@;->@;%a"
+                           (self#list self#core_type1 ~sep:"*@;") l
+                           self#core_type1 r
+                 | Pcstr_record _ ->
+                     pp f "{...}" (* #5528: TODO *)
+          )
+          l
+    | Pext_rebind li ->
+        pp f "%s@ = @ %a" x.pext_name.txt
+           self#longident_loc li
+
   method case_list f l : unit =
     let aux f {pc_lhs; pc_guard; pc_rhs} =
       pp f "@;| @[<2>%a%a@;->@;%a@]"
@@ -1233,12 +1255,12 @@ class printer  ()= object(self:'self)
             pp f "~%s:%a" lbl self#simple_expr e
 
   method directive_argument f x =
-    match x with
+    (match x with
+    | Pdir_none -> ()
     | Pdir_string (s) -> pp f "@ %S" s
     | Pdir_int (i) -> pp f "@ %d" i
     | Pdir_ident (li) -> pp f "@ %a" self#longident li
-    | Pdir_bool (b) -> pp f "@ %s" (string_of_bool b)
-    | Pdir_keyword s -> pp f "@ %s" s
+    | Pdir_bool (b) -> pp f "@ %s" (string_of_bool b))
 
   method toplevel_phrase f x =
     match x with
@@ -1247,8 +1269,7 @@ class printer  ()= object(self:'self)
         self#list self#structure_item f s ;
         pp_close_box f ();
     | Ptop_dir (s, da) ->
-        pp f "@[<hov2>#%s@ %a@]" s
-          (self#list ~sep:" " self#directive_argument) da
+        pp f "@[<hov2>#%s@ %a@]" s self#directive_argument da
 end;;
 
 
@@ -1262,8 +1283,7 @@ let toplevel_phrase f x =
    (* pp_print_list structure_item f s ; *)
    (* pp_close_box f (); *)
   | Ptop_dir (s, da) ->
-   pp f "@[<hov2>#%s@ %a@]" s
-     (default#list ~sep:" " default#directive_argument) da
+   pp f "@[<hov2>#%s@ %a@]" s default#directive_argument da
    (* pp f "@[<hov2>#%s@ %a@]" s directive_argument da *)
 
 let expression f x =
diff --git a/parsing/pprintast.mli b/parsing/pprintast.mli
index 86297cea82..316218d310 100644
--- a/parsing/pprintast.mli
+++ b/parsing/pprintast.mli
@@ -27,7 +27,7 @@ class printer :
     method class_expr : Format.formatter -> Parsetree.class_expr -> unit
     method class_field : Format.formatter -> Parsetree.class_field -> unit
     method class_params_def :
-      Format.formatter -> (string Asttypes.loc * Asttypes.variance) list -> unit
+      Format.formatter -> (Parsetree.core_type * Asttypes.variance) list -> unit
     method class_signature :
       Format.formatter -> Parsetree.class_signature -> unit
     method class_structure :
@@ -44,10 +44,12 @@ class printer :
     method directive_argument :
       Format.formatter -> Parsetree.directive_argument -> unit
     method exception_declaration :
-      Format.formatter -> Parsetree.constructor_declaration -> unit
+      Format.formatter -> Parsetree.extension_constructor -> unit
     method expression : Format.formatter -> Parsetree.expression -> unit
     method expression1 : Format.formatter -> Parsetree.expression -> unit
     method expression2 : Format.formatter -> Parsetree.expression -> unit
+    method extension_constructor :
+      Format.formatter -> Parsetree.extension_constructor -> unit
     method label_exp :
       Format.formatter ->
       Asttypes.label * Parsetree.expression option * Parsetree.pattern ->
@@ -102,10 +104,10 @@ class printer :
       Format.formatter -> Parsetree.type_declaration -> unit
     method type_def_list :
       Format.formatter -> Parsetree.type_declaration list -> unit
+    method type_extension :
+      Format.formatter -> Parsetree.type_extension -> unit
     method type_param :
-      Format.formatter -> string Asttypes.loc option * Asttypes.variance -> unit
-    method type_var_option :
-      Format.formatter -> string Asttypes.loc option -> unit
+      Format.formatter -> Parsetree.core_type * Asttypes.variance -> unit
     method type_with_label :
       Format.formatter -> Asttypes.label * Parsetree.core_type -> unit
     method tyvar : Format.formatter -> string -> unit
diff --git a/parsing/printast.ml b/parsing/printast.ml
index 5c4e8d74f1..70f90dea1d 100644
--- a/parsing/printast.ml
+++ b/parsing/printast.ml
@@ -157,8 +157,9 @@ let rec core_type i ppf x =
       line i ppf "Ptyp_object %a\n" fmt_closed_flag c;
       let i = i + 1 in
       List.iter
-        (fun (s, t) ->
-          line i ppf "method %s" s;
+        (fun (s, attrs, t) ->
+          line i ppf "method %s\n" s;
+          attributes i ppf attrs;
           core_type (i + 1) ppf t
         )
         l
@@ -227,6 +228,9 @@ and pattern i ppf x =
       longident_loc i ppf li
   | Ppat_unpack s ->
       line i ppf "Ppat_unpack %a\n" fmt_string_loc s;
+  | Ppat_exception p ->
+      line i ppf "Ppat_exception\n";
+      pattern i ppf p
   | Ppat_extension (s, arg) ->
       line i ppf "Ppat_extension \"%s\"\n" s.txt;
       payload i ppf arg
@@ -363,12 +367,7 @@ and value_description i ppf x =
   core_type (i+1) ppf x.pval_type;
   list (i+1) string ppf x.pval_prim
 
-and type_parameter i ppf (x, _variance) =
-  match x with
-  | Some x ->
-      string_loc i ppf x
-  | None ->
-      string i ppf "_"
+and type_parameter i ppf (x, _variance) = core_type i ppf x
 
 and type_declaration i ppf x =
   line i ppf "type_declaration %a %a\n" fmt_string_loc x.ptype_name
@@ -414,6 +413,37 @@ and type_kind i ppf x =
   | Ptype_record l ->
       line i ppf "Ptype_record\n";
       list (i+1) label_decl ppf l;
+  | Ptype_open ->
+      line i ppf "Ptype_open\n";
+
+and type_extension i ppf x =
+  line i ppf "type_extension\n";
+  attributes i ppf x.ptyext_attributes;
+  let i = i+1 in
+  line i ppf "ptyext_path = %a\n" fmt_longident_loc x.ptyext_path;
+  line i ppf "ptyext_params =\n";
+  list (i+1) type_parameter ppf x.ptyext_params;
+  line i ppf "ptyext_constructors =\n";
+  list (i+1) extension_constructor ppf x.ptyext_constructors;
+  line i ppf "ptyext_private = %a\n" fmt_private_flag x.ptyext_private;
+
+and extension_constructor i ppf x =
+  line i ppf "extension_constructor %a\n" fmt_location x.pext_loc;
+  attributes i ppf x.pext_attributes;
+  let i = i + 1 in
+  line i ppf "pext_name = \"%s\"\n" x.pext_name.txt;
+  line i ppf "pext_kind =\n";
+  extension_constructor_kind (i + 1) ppf x.pext_kind;
+
+and extension_constructor_kind i ppf x =
+  match x with
+      Pext_decl(a, r) ->
+        line i ppf "Pext_decl\n";
+        constructor_arguments (i+1) ppf a;
+        option (i+1) core_type ppf r;
+    | Pext_rebind li ->
+        line i ppf "Pext_rebind\n";
+        line (i+1) ppf "%a\n" fmt_longident_loc li;
 
 and class_type i ppf x =
   line i ppf "class_type %a\n" fmt_location x.pcty_loc;
@@ -459,6 +489,9 @@ and class_type_field i ppf x =
       line i ppf "Pctf_constraint\n";
       core_type (i+1) ppf ct1;
       core_type (i+1) ppf ct2;
+  | Pctf_attribute (s, arg) ->
+      line i ppf "Pctf_attribute \"%s\"\n" s.txt;
+      payload i ppf arg
   | Pctf_extension (s, arg) ->
       line i ppf "Pctf_extension \"%s\"\n" s.txt;
      payload i ppf arg
@@ -469,7 +502,7 @@ and class_description i ppf x =
   let i = i+1 in
   line i ppf "pci_virt = %a\n" fmt_virtual_flag x.pci_virt;
   line i ppf "pci_params =\n";
-  cl_type_parameters (i+1) ppf x.pci_params;
+  list (i+1) type_parameter ppf x.pci_params;
   line i ppf "pci_name = %a\n" fmt_string_loc x.pci_name;
   line i ppf "pci_expr =\n";
   class_type (i+1) ppf x.pci_expr;
@@ -480,7 +513,7 @@ and class_type_declaration i ppf x =
   let i = i+1 in
   line i ppf "pci_virt = %a\n" fmt_virtual_flag x.pci_virt;
   line i ppf "pci_params =\n";
-  cl_type_parameters (i+1) ppf x.pci_params;
+  list (i+1) type_parameter ppf x.pci_params;
   line i ppf "pci_name = %a\n" fmt_string_loc x.pci_name;
   line i ppf "pci_expr =\n";
   class_type (i+1) ppf x.pci_expr;
@@ -547,6 +580,9 @@ and class_field i ppf x =
   | Pcf_initializer (e) ->
       line i ppf "Pcf_initializer\n";
       expression (i+1) ppf e;
+  | Pcf_attribute (s, arg) ->
+      line i ppf "Pcf_attribute \"%s\"\n" s.txt;
+      payload i ppf arg
   | Pcf_extension (s, arg) ->
       line i ppf "Pcf_extension \"%s\"\n" s.txt;
       payload i ppf arg
@@ -565,7 +601,7 @@ and class_declaration i ppf x =
   let i = i+1 in
   line i ppf "pci_virt = %a\n" fmt_virtual_flag x.pci_virt;
   line i ppf "pci_params =\n";
-  cl_type_parameters (i+1) ppf x.pci_params;
+  list (i+1) type_parameter ppf x.pci_params;
   line i ppf "pci_name = %a\n" fmt_string_loc x.pci_name;
   line i ppf "pci_expr =\n";
   class_expr (i+1) ppf x.pci_expr;
@@ -607,9 +643,12 @@ and signature_item i ppf x =
   | Psig_type (l) ->
       line i ppf "Psig_type\n";
       list i type_declaration ppf l;
-  | Psig_exception cd ->
+  | Psig_typext te ->
+      line i ppf "Psig_typext\n";
+      type_extension i ppf te
+  | Psig_exception ext ->
       line i ppf "Psig_exception\n";
-      constructor_decl i ppf cd;
+      extension_constructor i ppf ext;
   | Psig_module pmd ->
       line i ppf "Psig_module %a\n" fmt_string_loc pmd.pmd_name;
       attributes i ppf pmd.pmd_attributes;
@@ -712,14 +751,12 @@ and structure_item i ppf x =
   | Pstr_type l ->
       line i ppf "Pstr_type\n";
       list i type_declaration ppf l;
-  | Pstr_exception cd ->
+  | Pstr_typext te ->
+      line i ppf "Pstr_typext\n";
+      type_extension i ppf te
+  | Pstr_exception ext ->
       line i ppf "Pstr_exception\n";
-      constructor_decl i ppf cd;
-  | Pstr_exn_rebind er ->
-      line i ppf "Pstr_exn_rebind\n";
-      attributes i ppf er.pexrb_attributes;
-      line (i+1) ppf "%a\n" fmt_string_loc er.pexrb_name;
-      line (i+1) ppf "%a\n" fmt_longident_loc er.pexrb_lid
+      extension_constructor i ppf ext;
   | Pstr_module x ->
       line i ppf "Pstr_module\n";
       module_binding i ppf x
@@ -771,14 +808,15 @@ and core_type_x_core_type_x_location i ppf (ct1, ct2, l) =
 and constructor_decl i ppf
                      {pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes} =
   line i ppf "%a\n" fmt_location pcd_loc;
-  attributes i ppf pcd_attributes;
   line (i+1) ppf "%a\n" fmt_string_loc pcd_name;
-  begin match pcd_args with
-  | Pcstr_tuple l -> list (i+1) core_type ppf l;
-  | Pcstr_record l -> list (i+1) label_decl ppf l
-  end;
+  attributes i ppf pcd_attributes;
+  constructor_arguments (i+1) ppf pcd_args;
   option (i+1) core_type ppf pcd_res
 
+and constructor_arguments i ppf = function
+  | Pcstr_tuple l -> list i core_type ppf l;
+  | Pcstr_record l -> list i label_decl ppf l
+
 and label_decl i ppf {pld_name; pld_mutable; pld_type; pld_loc; pld_attributes}=
   line i ppf "%a\n" fmt_location pld_loc;
   attributes i ppf pld_attributes;
@@ -786,13 +824,6 @@ and label_decl i ppf {pld_name; pld_mutable; pld_type; pld_loc; pld_attributes}=
   line (i+1) ppf "%a" fmt_string_loc pld_name;
   core_type (i+1) ppf pld_type
 
-and cl_type_parameters i ppf l =
-  line i ppf "<params>\n";
-  list (i+1) cl_type_parameter ppf l;
-
-and cl_type_parameter i ppf (x, _variance) =
-  string_loc i ppf x
-
 and longident_x_pattern i ppf (li, p) =
   line i ppf "%a\n" fmt_longident_loc li;
   pattern (i+1) ppf p;
@@ -826,8 +857,9 @@ and label_x_expression i ppf (l,e) =
 
 and label_x_bool_x_core_type_list i ppf x =
   match x with
-    Rtag (l, b, ctl) ->
+    Rtag (l, attrs, b, ctl) ->
       line i ppf "Rtag \"%s\" %s\n" l (string_of_bool b);
+      attributes (i+1) ppf attrs;
       list (i+1) core_type ppf ctl
   | Rinherit (ct) ->
       line i ppf "Rinherit\n";
@@ -841,15 +873,15 @@ let rec toplevel_phrase i ppf x =
       structure (i+1) ppf s;
   | Ptop_dir (s, da) ->
       line i ppf "Ptop_dir \"%s\"\n" s;
-      list i directive_argument ppf da;
+      directive_argument i ppf da;
 
 and directive_argument i ppf x =
   match x with
+  | Pdir_none -> line i ppf "Pdir_none\n"
   | Pdir_string (s) -> line i ppf "Pdir_string \"%s\"\n" s;
   | Pdir_int (i) -> line i ppf "Pdir_int %d\n" i;
   | Pdir_ident (li) -> line i ppf "Pdir_ident %a\n" fmt_longident li;
   | Pdir_bool (b) -> line i ppf "Pdir_bool %s\n" (string_of_bool b);
-  | Pdir_keyword s -> line i ppf "Pdir_keyword %s\n" s;
 ;;
 
 let interface ppf x = list 0 signature_item ppf x;;
diff --git a/stdlib/.depend b/stdlib/.depend
index e5b65ad513..e3a0a671d1 100644
--- a/stdlib/.depend
+++ b/stdlib/.depend
@@ -2,7 +2,11 @@ arg.cmi :
 array.cmi :
 arrayLabels.cmi :
 buffer.cmi :
+bytes.cmi :
+bytesLabels.cmi :
 callback.cmi :
+camlinternalFormat.cmi : camlinternalFormatBasics.cmi buffer.cmi
+camlinternalFormatBasics.cmi :
 camlinternalLazy.cmi :
 camlinternalMod.cmi : obj.cmi
 camlinternalOO.cmi : obj.cmi
@@ -27,16 +31,17 @@ nativeint.cmi :
 obj.cmi : int32.cmi
 oo.cmi : camlinternalOO.cmi
 parsing.cmi : obj.cmi lexing.cmi
-pervasives.cmi :
+pervasives.cmi : camlinternalFormatBasics.cmi
 printexc.cmi :
-printf.cmi : obj.cmi buffer.cmi
+printf.cmi : buffer.cmi
 queue.cmi :
 random.cmi : nativeint.cmi int64.cmi int32.cmi
 scanf.cmi : pervasives.cmi
 set.cmi :
 sort.cmi :
 stack.cmi :
-stdLabels.cmi : stringLabels.cmi listLabels.cmi arrayLabels.cmi
+stdLabels.cmi : stringLabels.cmi listLabels.cmi bytesLabels.cmi \
+    arrayLabels.cmi
 stream.cmi :
 string.cmi :
 stringLabels.cmi :
@@ -50,10 +55,20 @@ array.cmo : array.cmi
 array.cmx : array.cmi
 arrayLabels.cmo : array.cmi arrayLabels.cmi
 arrayLabels.cmx : array.cmx arrayLabels.cmi
-buffer.cmo : sys.cmi string.cmi buffer.cmi
-buffer.cmx : sys.cmx string.cmx buffer.cmi
+buffer.cmo : sys.cmi string.cmi bytes.cmi buffer.cmi
+buffer.cmx : sys.cmx string.cmx bytes.cmx buffer.cmi
+bytes.cmo : pervasives.cmi list.cmi char.cmi bytes.cmi
+bytes.cmx : pervasives.cmx list.cmx char.cmx bytes.cmi
+bytesLabels.cmo : bytes.cmi bytesLabels.cmi
+bytesLabels.cmx : bytes.cmx bytesLabels.cmi
 callback.cmo : obj.cmi callback.cmi
 callback.cmx : obj.cmx callback.cmi
+camlinternalFormat.cmo : sys.cmi string.cmi char.cmi \
+    camlinternalFormatBasics.cmi bytes.cmi buffer.cmi camlinternalFormat.cmi
+camlinternalFormat.cmx : sys.cmx string.cmx char.cmx \
+    camlinternalFormatBasics.cmx bytes.cmx buffer.cmx camlinternalFormat.cmi
+camlinternalFormatBasics.cmo : camlinternalFormatBasics.cmi
+camlinternalFormatBasics.cmx : camlinternalFormatBasics.cmi
 camlinternalLazy.cmo : obj.cmi camlinternalLazy.cmi
 camlinternalLazy.cmx : obj.cmx camlinternalLazy.cmi
 camlinternalMod.cmo : obj.cmi camlinternalOO.cmi array.cmi \
@@ -68,20 +83,22 @@ char.cmo : char.cmi
 char.cmx : char.cmi
 complex.cmo : complex.cmi
 complex.cmx : complex.cmi
-digest.cmo : string.cmi char.cmi digest.cmi
-digest.cmx : string.cmx char.cmx digest.cmi
+digest.cmo : string.cmi char.cmi bytes.cmi digest.cmi
+digest.cmx : string.cmx char.cmx bytes.cmx digest.cmi
 filename.cmo : sys.cmi string.cmi random.cmi printf.cmi lazy.cmi buffer.cmi \
     filename.cmi
 filename.cmx : sys.cmx string.cmx random.cmx printf.cmx lazy.cmx buffer.cmx \
     filename.cmi
-format.cmo : string.cmi printf.cmi pervasives.cmi obj.cmi list.cmi \
-    buffer.cmi format.cmi
-format.cmx : string.cmx printf.cmx pervasives.cmx obj.cmx list.cmx \
-    buffer.cmx format.cmi
+format.cmo : string.cmi pervasives.cmi camlinternalFormatBasics.cmi \
+    camlinternalFormat.cmi buffer.cmi format.cmi
+format.cmx : string.cmx pervasives.cmx camlinternalFormatBasics.cmx \
+    camlinternalFormat.cmx buffer.cmx format.cmi
 gc.cmo : sys.cmi printf.cmi gc.cmi
 gc.cmx : sys.cmx printf.cmx gc.cmi
-genlex.cmo : string.cmi stream.cmi list.cmi hashtbl.cmi char.cmi genlex.cmi
-genlex.cmx : string.cmx stream.cmx list.cmx hashtbl.cmx char.cmx genlex.cmi
+genlex.cmo : string.cmi stream.cmi list.cmi hashtbl.cmi char.cmi bytes.cmi \
+    genlex.cmi
+genlex.cmx : string.cmx stream.cmx list.cmx hashtbl.cmx char.cmx bytes.cmx \
+    genlex.cmi
 hashtbl.cmo : sys.cmi string.cmi random.cmi obj.cmi lazy.cmi array.cmi \
     hashtbl.cmi
 hashtbl.cmx : sys.cmx string.cmx random.cmx obj.cmx lazy.cmx array.cmx \
@@ -92,16 +109,16 @@ int64.cmo : pervasives.cmi int64.cmi
 int64.cmx : pervasives.cmx int64.cmi
 lazy.cmo : obj.cmi camlinternalLazy.cmi lazy.cmi
 lazy.cmx : obj.cmx camlinternalLazy.cmx lazy.cmi
-lexing.cmo : sys.cmi string.cmi array.cmi lexing.cmi
-lexing.cmx : sys.cmx string.cmx array.cmx lexing.cmi
+lexing.cmo : sys.cmi string.cmi bytes.cmi array.cmi lexing.cmi
+lexing.cmx : sys.cmx string.cmx bytes.cmx array.cmx lexing.cmi
 list.cmo : list.cmi
 list.cmx : list.cmi
 listLabels.cmo : list.cmi listLabels.cmi
 listLabels.cmx : list.cmx listLabels.cmi
 map.cmo : map.cmi
 map.cmx : map.cmi
-marshal.cmo : string.cmi marshal.cmi
-marshal.cmx : string.cmx marshal.cmi
+marshal.cmo : bytes.cmi marshal.cmi
+marshal.cmx : bytes.cmx marshal.cmi
 moreLabels.cmo : set.cmi map.cmi hashtbl.cmi moreLabels.cmi
 moreLabels.cmx : set.cmx map.cmx hashtbl.cmx moreLabels.cmi
 nativeint.cmo : sys.cmi pervasives.cmi nativeint.cmi
@@ -112,13 +129,15 @@ oo.cmo : camlinternalOO.cmi oo.cmi
 oo.cmx : camlinternalOO.cmx oo.cmi
 parsing.cmo : obj.cmi lexing.cmi array.cmi parsing.cmi
 parsing.cmx : obj.cmx lexing.cmx array.cmx parsing.cmi
-pervasives.cmo : pervasives.cmi
-pervasives.cmx : pervasives.cmi
-printexc.cmo : printf.cmi obj.cmi buffer.cmi array.cmi printexc.cmi
-printexc.cmx : printf.cmx obj.cmx buffer.cmx array.cmx printexc.cmi
-printf.cmo : string.cmi obj.cmi list.cmi char.cmi buffer.cmi array.cmi \
+pervasives.cmo : camlinternalFormatBasics.cmi pervasives.cmi
+pervasives.cmx : camlinternalFormatBasics.cmx pervasives.cmi
+printexc.cmo : printf.cmi pervasives.cmi obj.cmi buffer.cmi array.cmi \
+    printexc.cmi
+printexc.cmx : printf.cmx pervasives.cmx obj.cmx buffer.cmx array.cmx \
+    printexc.cmi
+printf.cmo : camlinternalFormatBasics.cmi camlinternalFormat.cmi buffer.cmi \
     printf.cmi
-printf.cmx : string.cmx obj.cmx list.cmx char.cmx buffer.cmx array.cmx \
+printf.cmx : camlinternalFormatBasics.cmx camlinternalFormat.cmx buffer.cmx \
     printf.cmi
 queue.cmo : obj.cmi queue.cmi
 queue.cmx : obj.cmx queue.cmi
@@ -126,26 +145,28 @@ random.cmo : string.cmi pervasives.cmi nativeint.cmi int64.cmi int32.cmi \
     digest.cmi char.cmi array.cmi random.cmi
 random.cmx : string.cmx pervasives.cmx nativeint.cmx int64.cmx int32.cmx \
     digest.cmx char.cmx array.cmx random.cmi
-scanf.cmo : string.cmi printf.cmi pervasives.cmi obj.cmi list.cmi \
-    hashtbl.cmi buffer.cmi array.cmi scanf.cmi
-scanf.cmx : string.cmx printf.cmx pervasives.cmx obj.cmx list.cmx \
-    hashtbl.cmx buffer.cmx array.cmx scanf.cmi
+scanf.cmo : string.cmi printf.cmi pervasives.cmi list.cmi \
+    camlinternalFormatBasics.cmi camlinternalFormat.cmi bytes.cmi buffer.cmi \
+    scanf.cmi
+scanf.cmx : string.cmx printf.cmx pervasives.cmx list.cmx \
+    camlinternalFormatBasics.cmx camlinternalFormat.cmx bytes.cmx buffer.cmx \
+    scanf.cmi
 set.cmo : list.cmi set.cmi
 set.cmx : list.cmx set.cmi
 sort.cmo : array.cmi sort.cmi
 sort.cmx : array.cmx sort.cmi
 stack.cmo : list.cmi stack.cmi
 stack.cmx : list.cmx stack.cmi
-stdLabels.cmo : stringLabels.cmi listLabels.cmi arrayLabels.cmi \
-    stdLabels.cmi
-stdLabels.cmx : stringLabels.cmx listLabels.cmx arrayLabels.cmx \
-    stdLabels.cmi
+stdLabels.cmo : stringLabels.cmi listLabels.cmi bytesLabels.cmi \
+    arrayLabels.cmi stdLabels.cmi
+stdLabels.cmx : stringLabels.cmx listLabels.cmx bytesLabels.cmx \
+    arrayLabels.cmx stdLabels.cmi
 std_exit.cmo :
 std_exit.cmx :
-stream.cmo : string.cmi obj.cmi list.cmi lazy.cmi stream.cmi
-stream.cmx : string.cmx obj.cmx list.cmx lazy.cmx stream.cmi
-string.cmo : pervasives.cmi list.cmi char.cmi string.cmi
-string.cmx : pervasives.cmx list.cmx char.cmx string.cmi
+stream.cmo : string.cmi obj.cmi list.cmi lazy.cmi bytes.cmi stream.cmi
+stream.cmx : string.cmx obj.cmx list.cmx lazy.cmx bytes.cmx stream.cmi
+string.cmo : pervasives.cmi obj.cmi bytes.cmi string.cmi
+string.cmx : pervasives.cmx obj.cmx bytes.cmx string.cmi
 stringLabels.cmo : string.cmi stringLabels.cmi
 stringLabels.cmx : string.cmx stringLabels.cmi
 sys.cmo : sys.cmi
@@ -160,10 +181,20 @@ array.cmo : array.cmi
 array.p.cmx : array.cmi
 arrayLabels.cmo : array.cmi arrayLabels.cmi
 arrayLabels.p.cmx : array.p.cmx arrayLabels.cmi
-buffer.cmo : sys.cmi string.cmi buffer.cmi
-buffer.p.cmx : sys.p.cmx string.p.cmx buffer.cmi
+buffer.cmo : sys.cmi string.cmi bytes.cmi buffer.cmi
+buffer.p.cmx : sys.p.cmx string.p.cmx bytes.p.cmx buffer.cmi
+bytes.cmo : pervasives.cmi list.cmi char.cmi bytes.cmi
+bytes.p.cmx : pervasives.p.cmx list.p.cmx char.p.cmx bytes.cmi
+bytesLabels.cmo : bytes.cmi bytesLabels.cmi
+bytesLabels.p.cmx : bytes.p.cmx bytesLabels.cmi
 callback.cmo : obj.cmi callback.cmi
 callback.p.cmx : obj.p.cmx callback.cmi
+camlinternalFormat.cmo : sys.cmi string.cmi char.cmi \
+    camlinternalFormatBasics.cmi bytes.cmi buffer.cmi camlinternalFormat.cmi
+camlinternalFormat.p.cmx : sys.p.cmx string.p.cmx char.p.cmx \
+    camlinternalFormatBasics.p.cmx bytes.p.cmx buffer.p.cmx camlinternalFormat.cmi
+camlinternalFormatBasics.cmo : camlinternalFormatBasics.cmi
+camlinternalFormatBasics.p.cmx : camlinternalFormatBasics.cmi
 camlinternalLazy.cmo : obj.cmi camlinternalLazy.cmi
 camlinternalLazy.p.cmx : obj.p.cmx camlinternalLazy.cmi
 camlinternalMod.cmo : obj.cmi camlinternalOO.cmi array.cmi \
@@ -178,20 +209,22 @@ char.cmo : char.cmi
 char.p.cmx : char.cmi
 complex.cmo : complex.cmi
 complex.p.cmx : complex.cmi
-digest.cmo : string.cmi char.cmi digest.cmi
-digest.p.cmx : string.p.cmx char.p.cmx digest.cmi
+digest.cmo : string.cmi char.cmi bytes.cmi digest.cmi
+digest.p.cmx : string.p.cmx char.p.cmx bytes.p.cmx digest.cmi
 filename.cmo : sys.cmi string.cmi random.cmi printf.cmi lazy.cmi buffer.cmi \
     filename.cmi
 filename.p.cmx : sys.p.cmx string.p.cmx random.p.cmx printf.p.cmx lazy.p.cmx buffer.p.cmx \
     filename.cmi
-format.cmo : string.cmi printf.cmi pervasives.cmi obj.cmi list.cmi \
-    buffer.cmi format.cmi
-format.p.cmx : string.p.cmx printf.p.cmx pervasives.p.cmx obj.p.cmx list.p.cmx \
-    buffer.p.cmx format.cmi
+format.cmo : string.cmi pervasives.cmi camlinternalFormatBasics.cmi \
+    camlinternalFormat.cmi buffer.cmi format.cmi
+format.p.cmx : string.p.cmx pervasives.p.cmx camlinternalFormatBasics.p.cmx \
+    camlinternalFormat.p.cmx buffer.p.cmx format.cmi
 gc.cmo : sys.cmi printf.cmi gc.cmi
 gc.p.cmx : sys.p.cmx printf.p.cmx gc.cmi
-genlex.cmo : string.cmi stream.cmi list.cmi hashtbl.cmi char.cmi genlex.cmi
-genlex.p.cmx : string.p.cmx stream.p.cmx list.p.cmx hashtbl.p.cmx char.p.cmx genlex.cmi
+genlex.cmo : string.cmi stream.cmi list.cmi hashtbl.cmi char.cmi bytes.cmi \
+    genlex.cmi
+genlex.p.cmx : string.p.cmx stream.p.cmx list.p.cmx hashtbl.p.cmx char.p.cmx bytes.p.cmx \
+    genlex.cmi
 hashtbl.cmo : sys.cmi string.cmi random.cmi obj.cmi lazy.cmi array.cmi \
     hashtbl.cmi
 hashtbl.p.cmx : sys.p.cmx string.p.cmx random.p.cmx obj.p.cmx lazy.p.cmx array.p.cmx \
@@ -202,16 +235,16 @@ int64.cmo : pervasives.cmi int64.cmi
 int64.p.cmx : pervasives.p.cmx int64.cmi
 lazy.cmo : obj.cmi camlinternalLazy.cmi lazy.cmi
 lazy.p.cmx : obj.p.cmx camlinternalLazy.p.cmx lazy.cmi
-lexing.cmo : sys.cmi string.cmi array.cmi lexing.cmi
-lexing.p.cmx : sys.p.cmx string.p.cmx array.p.cmx lexing.cmi
+lexing.cmo : sys.cmi string.cmi bytes.cmi array.cmi lexing.cmi
+lexing.p.cmx : sys.p.cmx string.p.cmx bytes.p.cmx array.p.cmx lexing.cmi
 list.cmo : list.cmi
 list.p.cmx : list.cmi
 listLabels.cmo : list.cmi listLabels.cmi
 listLabels.p.cmx : list.p.cmx listLabels.cmi
 map.cmo : map.cmi
 map.p.cmx : map.cmi
-marshal.cmo : string.cmi marshal.cmi
-marshal.p.cmx : string.p.cmx marshal.cmi
+marshal.cmo : bytes.cmi marshal.cmi
+marshal.p.cmx : bytes.p.cmx marshal.cmi
 moreLabels.cmo : set.cmi map.cmi hashtbl.cmi moreLabels.cmi
 moreLabels.p.cmx : set.p.cmx map.p.cmx hashtbl.p.cmx moreLabels.cmi
 nativeint.cmo : sys.cmi pervasives.cmi nativeint.cmi
@@ -222,13 +255,15 @@ oo.cmo : camlinternalOO.cmi oo.cmi
 oo.p.cmx : camlinternalOO.p.cmx oo.cmi
 parsing.cmo : obj.cmi lexing.cmi array.cmi parsing.cmi
 parsing.p.cmx : obj.p.cmx lexing.p.cmx array.p.cmx parsing.cmi
-pervasives.cmo : pervasives.cmi
-pervasives.p.cmx : pervasives.cmi
-printexc.cmo : printf.cmi obj.cmi buffer.cmi array.cmi printexc.cmi
-printexc.p.cmx : printf.p.cmx obj.p.cmx buffer.p.cmx array.p.cmx printexc.cmi
-printf.cmo : string.cmi obj.cmi list.cmi char.cmi buffer.cmi array.cmi \
+pervasives.cmo : camlinternalFormatBasics.cmi pervasives.cmi
+pervasives.p.cmx : camlinternalFormatBasics.p.cmx pervasives.cmi
+printexc.cmo : printf.cmi pervasives.cmi obj.cmi buffer.cmi array.cmi \
+    printexc.cmi
+printexc.p.cmx : printf.p.cmx pervasives.p.cmx obj.p.cmx buffer.p.cmx array.p.cmx \
+    printexc.cmi
+printf.cmo : camlinternalFormatBasics.cmi camlinternalFormat.cmi buffer.cmi \
     printf.cmi
-printf.p.cmx : string.p.cmx obj.p.cmx list.p.cmx char.p.cmx buffer.p.cmx array.p.cmx \
+printf.p.cmx : camlinternalFormatBasics.p.cmx camlinternalFormat.p.cmx buffer.p.cmx \
     printf.cmi
 queue.cmo : obj.cmi queue.cmi
 queue.p.cmx : obj.p.cmx queue.cmi
@@ -236,26 +271,28 @@ random.cmo : string.cmi pervasives.cmi nativeint.cmi int64.cmi int32.cmi \
     digest.cmi char.cmi array.cmi random.cmi
 random.p.cmx : string.p.cmx pervasives.p.cmx nativeint.p.cmx int64.p.cmx int32.p.cmx \
     digest.p.cmx char.p.cmx array.p.cmx random.cmi
-scanf.cmo : string.cmi printf.cmi pervasives.cmi obj.cmi list.cmi \
-    hashtbl.cmi buffer.cmi array.cmi scanf.cmi
-scanf.p.cmx : string.p.cmx printf.p.cmx pervasives.p.cmx obj.p.cmx list.p.cmx \
-    hashtbl.p.cmx buffer.p.cmx array.p.cmx scanf.cmi
+scanf.cmo : string.cmi printf.cmi pervasives.cmi list.cmi \
+    camlinternalFormatBasics.cmi camlinternalFormat.cmi bytes.cmi buffer.cmi \
+    scanf.cmi
+scanf.p.cmx : string.p.cmx printf.p.cmx pervasives.p.cmx list.p.cmx \
+    camlinternalFormatBasics.p.cmx camlinternalFormat.p.cmx bytes.p.cmx buffer.p.cmx \
+    scanf.cmi
 set.cmo : list.cmi set.cmi
 set.p.cmx : list.p.cmx set.cmi
 sort.cmo : array.cmi sort.cmi
 sort.p.cmx : array.p.cmx sort.cmi
 stack.cmo : list.cmi stack.cmi
 stack.p.cmx : list.p.cmx stack.cmi
-stdLabels.cmo : stringLabels.cmi listLabels.cmi arrayLabels.cmi \
-    stdLabels.cmi
-stdLabels.p.cmx : stringLabels.p.cmx listLabels.p.cmx arrayLabels.p.cmx \
-    stdLabels.cmi
+stdLabels.cmo : stringLabels.cmi listLabels.cmi bytesLabels.cmi \
+    arrayLabels.cmi stdLabels.cmi
+stdLabels.p.cmx : stringLabels.p.cmx listLabels.p.cmx bytesLabels.p.cmx \
+    arrayLabels.p.cmx stdLabels.cmi
 std_exit.cmo :
 std_exit.p.cmx :
-stream.cmo : string.cmi obj.cmi list.cmi lazy.cmi stream.cmi
-stream.p.cmx : string.p.cmx obj.p.cmx list.p.cmx lazy.p.cmx stream.cmi
-string.cmo : pervasives.cmi list.cmi char.cmi string.cmi
-string.p.cmx : pervasives.p.cmx list.p.cmx char.p.cmx string.cmi
+stream.cmo : string.cmi obj.cmi list.cmi lazy.cmi bytes.cmi stream.cmi
+stream.p.cmx : string.p.cmx obj.p.cmx list.p.cmx lazy.p.cmx bytes.p.cmx stream.cmi
+string.cmo : pervasives.cmi obj.cmi bytes.cmi string.cmi
+string.p.cmx : pervasives.p.cmx obj.p.cmx bytes.p.cmx string.cmi
 stringLabels.cmo : string.cmi stringLabels.cmi
 stringLabels.p.cmx : string.p.cmx stringLabels.cmi
 sys.cmo : sys.cmi
diff --git a/stdlib/Compflags b/stdlib/Compflags
index d0938af89a..f393c4ec00 100755
--- a/stdlib/Compflags
+++ b/stdlib/Compflags
@@ -18,8 +18,11 @@ case $1 in
   camlinternalOO.cmx|camlinternalOO.p.cmx) echo ' -inline 0';;
   buffer.cmx|buffer.p.cmx) echo ' -inline 3';;
                            # make sure add_char is inlined (PR#5872)
-  buffer.cm[io]|printf.cm[io]|format.cm[io]|scanf.cm[io]) echo ' -w A';;
+  buffer.cm[io]) echo ' -w A';;
+  camlinternalFormat.cm[io]) echo ' -w Ae';;
+  camlinternalFormatBasics*.cm[iox]) echo ' -nopervasives';;
+  printf.cm[io]|format.cm[io]|scanf.cm[io]) echo ' -w Ae';;
   scanf.cmx|scanf.p.cmx) echo ' -inline 9';;
-  *Labels.cm[ox]|*Labels.p.cmx) echo ' -nolabels -trans-mod';;
+  *Labels.cm[ox]|*Labels.p.cmx) echo ' -nolabels -no-alias-deps';;
   *) echo ' ';;
 esac
diff --git a/stdlib/Makefile.shared b/stdlib/Makefile.shared
index e4fee75d3c..54de337cb4 100755
--- a/stdlib/Makefile.shared
+++ b/stdlib/Makefile.shared
@@ -15,25 +15,27 @@ include ../config/Makefile
 RUNTIME=../boot/ocamlrun
 COMPILER=../ocamlc
 CAMLC=$(RUNTIME) $(COMPILER)
-COMPFLAGS=-strict-sequence -w +33..39 -g -warn-error A -bin-annot -nostdlib
+COMPFLAGS=-strict-sequence -w +33..39 -g -warn-error A -bin-annot -nostdlib \
+          -safe-string
 OPTCOMPILER=../ocamlopt
 CAMLOPT=$(RUNTIME) $(OPTCOMPILER)
 CAMLDEP=../boot/ocamlrun ../tools/ocamldep
 
-OBJS=pervasives.cmo $(OTHERS)
-OTHERS=array.cmo list.cmo char.cmo string.cmo sys.cmo \
+OBJS=camlinternalFormatBasics.cmo pervasives.cmo $(OTHERS)
+OTHERS=array.cmo list.cmo char.cmo bytes.cmo string.cmo sys.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 \
   camlinternalLazy.cmo lazy.cmo stream.cmo \
-  buffer.cmo printf.cmo \
+  buffer.cmo camlinternalFormat.cmo printf.cmo \
   arg.cmo printexc.cmo gc.cmo \
   digest.cmo random.cmo hashtbl.cmo format.cmo scanf.cmo callback.cmo \
   camlinternalOO.cmo oo.cmo camlinternalMod.cmo \
   genlex.cmo weak.cmo \
   filename.cmo complex.cmo \
-  arrayLabels.cmo listLabels.cmo stringLabels.cmo moreLabels.cmo stdLabels.cmo
+  arrayLabels.cmo listLabels.cmo bytesLabels.cmo \
+  stringLabels.cmo moreLabels.cmo stdLabels.cmo
 
 all: stdlib.cma std_exit.cmo camlheader camlheader_ur
 
@@ -86,7 +88,7 @@ $(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) 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
diff --git a/stdlib/StdlibModules b/stdlib/StdlibModules
index c5c8896ed0..a4552ad940 100644
--- a/stdlib/StdlibModules
+++ b/stdlib/StdlibModules
@@ -21,6 +21,8 @@ STDLIB_MODULES=\
   array \
   arrayLabels \
   buffer \
+  bytes \
+  bytesLabels \
   callback \
   camlinternalLazy \
   camlinternalMod \
diff --git a/stdlib/buffer.ml b/stdlib/buffer.ml
index 78a9e26116..2d6f691a27 100644
--- a/stdlib/buffer.ml
+++ b/stdlib/buffer.ml
@@ -14,41 +14,38 @@
 (* Extensible buffers *)
 
 type t =
- {mutable buffer : string;
+ {mutable buffer : bytes;
   mutable position : int;
   mutable length : int;
-  initial_buffer : string}
+  initial_buffer : bytes}
 
 let create n =
  let n = if n < 1 then 1 else n in
  let n = if n > Sys.max_string_length then Sys.max_string_length else n in
- let s = String.create n in
+ let s = Bytes.create n in
  {buffer = s; position = 0; length = n; initial_buffer = s}
 
-let contents b = String.sub b.buffer 0 b.position
+let contents b = Bytes.sub_string b.buffer 0 b.position
+let to_bytes b = Bytes.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.unsafe_blit b.buffer ofs r 0 len;
-    r
-  end
+  else Bytes.sub_string b.buffer ofs len
 ;;
 
 let blit src srcoff dst dstoff len =
   if len < 0 || srcoff < 0 || srcoff > src.position - len
-             || dstoff < 0 || dstoff > (String.length dst) - len
+             || dstoff < 0 || dstoff > (Bytes.length dst) - len
   then invalid_arg "Buffer.blit"
   else
-    String.blit src.buffer srcoff dst dstoff len
+    Bytes.blit src.buffer srcoff dst dstoff len
 ;;
 
 let nth b ofs =
   if ofs < 0 || ofs >= b.position then
    invalid_arg "Buffer.nth"
-  else String.unsafe_get b.buffer ofs
+  else Bytes.unsafe_get b.buffer ofs
 ;;
 
 let length b = b.position
@@ -57,7 +54,7 @@ let clear b = b.position <- 0
 
 let reset b =
   b.position <- 0; b.buffer <- b.initial_buffer;
-  b.length <- String.length b.buffer
+  b.length <- Bytes.length b.buffer
 
 let resize b more =
   let len = b.length in
@@ -68,34 +65,39 @@ let resize b more =
     then new_len := Sys.max_string_length
     else failwith "Buffer.add: cannot grow buffer"
   end;
-  let new_buffer = String.create !new_len in
-  String.blit b.buffer 0 new_buffer 0 b.position;
+  let new_buffer = Bytes.create !new_len in
+  Bytes.blit b.buffer 0 new_buffer 0 b.position;
   b.buffer <- new_buffer;
   b.length <- !new_len
 
 let add_char b c =
   let pos = b.position in
   if pos >= b.length then resize b 1;
-  String.unsafe_set b.buffer pos c;
+  Bytes.unsafe_set b.buffer pos c;
   b.position <- pos + 1
 
-let add_substring b s offset len =
-  if offset < 0 || len < 0 || offset > String.length s - len
-  then invalid_arg "Buffer.add_substring";
+let add_subbytes b s offset len =
+  if offset < 0 || len < 0 || offset > Bytes.length s - len
+  then invalid_arg "Buffer.add_subbytes";
   let new_position = b.position + len in
   if new_position > b.length then resize b len;
-  String.unsafe_blit s offset b.buffer b.position len;
+  Bytes.unsafe_blit s offset b.buffer b.position len;
   b.position <- new_position
 
-let add_string b s =
-  let len = String.length s in
+let add_substring b s offset len =
+  add_subbytes b (Bytes.unsafe_of_string s) offset len
+
+let add_bytes b s =
+  let len = Bytes.length s in
   let new_position = b.position + len in
   if new_position > b.length then resize b len;
-  String.unsafe_blit s 0 b.buffer b.position len;
+  Bytes.unsafe_blit s 0 b.buffer b.position len;
   b.position <- new_position
 
+let add_string b s = add_bytes b (Bytes.unsafe_of_string s)
+
 let add_buffer b bs =
-  add_substring b bs.buffer 0 bs.position
+  add_subbytes b bs.buffer 0 bs.position
 
 let add_channel b ic len =
   if len < 0 || len > Sys.max_string_length then   (* PR#5004 *)
diff --git a/stdlib/buffer.mli b/stdlib/buffer.mli
index c50c98792b..855a061667 100644
--- a/stdlib/buffer.mli
+++ b/stdlib/buffer.mli
@@ -11,9 +11,9 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(** Extensible string buffers.
+(** Extensible buffers.
 
-   This module implements string buffers that automatically expand
+   This module implements buffers that automatically expand
    as necessary.  It provides accumulative concatenation of strings
    in quasi-linear time (instead of quadratic time when strings are
    concatenated pairwise).
@@ -24,8 +24,8 @@ type t
 
 val create : int -> t
 (** [create n] returns a fresh buffer, initially empty.
-   The [n] parameter is the initial size of the internal string
-   that holds the buffer contents. That string is automatically
+   The [n] parameter is the initial size of the internal byte sequence
+   that holds the buffer contents. That byte sequence is automatically
    reallocated when more than [n] characters are stored in the buffer,
    but shrinks back to [n] characters when [reset] is called.
    For best performance, [n] should be of the same order of magnitude
@@ -40,20 +40,24 @@ val contents : t -> string
 (** Return a copy of the current contents of the buffer.
    The buffer itself is unchanged. *)
 
+val to_bytes : t -> bytes
+(** 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
+(** [Buffer.sub b off len] returns (a copy of) the bytes from 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 blit : t -> int -> string -> int -> int -> unit
+val blit : t -> int -> bytes -> int -> int -> unit
 (** [Buffer.blit src srcoff dst dstoff len] copies [len] characters from
    the current contents of the buffer [src], starting at offset [srcoff]
-   to string [dst], starting at character [dstoff].
+   to [dst], starting at character [dstoff].
 
    Raise [Invalid_argument] if [srcoff] and [len] do not designate a valid
-   substring of [src], or if [dstoff] and [len] do not designate a valid
-   substring of [dst].
+   range of [src], or if [dstoff] and [len] do not designate a valid
+   range of [dst].
    @since 3.11.2
 *)
 
@@ -68,8 +72,8 @@ val clear : t -> unit
 (** Empty the buffer. *)
 
 val reset : t -> unit
-(** Empty the buffer and deallocate the internal string holding the
-   buffer contents, replacing it with the initial internal string
+(** Empty the buffer and deallocate the internal byte sequence holding the
+   buffer contents, replacing it with the initial internal byte sequence
    of length [n] that was allocated by {!Buffer.create} [n].
    For long-lived buffers that may have grown a lot, [reset] allows
    faster reclamation of the space used by the buffer. *)
@@ -80,10 +84,17 @@ val add_char : t -> char -> unit
 val add_string : t -> string -> unit
 (** [add_string b s] appends the string [s] at the end of the buffer [b]. *)
 
+val add_bytes : t -> bytes -> unit
+(** [add_string b s] appends the string [s] at the end of the buffer [b]. *)
+
 val add_substring : t -> string -> int -> int -> unit
 (** [add_substring b s ofs len] takes [len] characters from offset
    [ofs] in string [s] and appends them at the end of the buffer [b]. *)
 
+val add_subbytes : t -> bytes -> int -> int -> unit
+(** [add_substring b s ofs len] takes [len] characters from offset
+   [ofs] in byte sequence [s] and appends them at the end of the buffer [b]. *)
+
 val add_substitute : t -> (string -> string) -> string -> unit
 (** [add_substitute b f s] appends the string pattern [s] at the end
    of the buffer [b] with substitution.
diff --git a/stdlib/bytes.ml b/stdlib/bytes.ml
new file mode 100644
index 0000000000..cfcd1ec05e
--- /dev/null
+++ b/stdlib/bytes.ml
@@ -0,0 +1,226 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the GNU Library General Public License, with    *)
+(*  the special exception on linking described in file ../LICENSE.     *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* Byte sequence operations *)
+
+external length : bytes -> int = "%string_length"
+external get : bytes -> int -> char = "%string_safe_get"
+external set : bytes -> int -> char -> unit = "%string_safe_set"
+external create : int -> bytes = "caml_create_string"
+external unsafe_get : bytes -> int -> char = "%string_unsafe_get"
+external unsafe_set : bytes -> int -> char -> unit = "%string_unsafe_set"
+external unsafe_blit : bytes -> int -> bytes -> int -> int -> unit
+                     = "caml_blit_string" "noalloc"
+external unsafe_fill : bytes -> int -> int -> char -> unit
+                     = "caml_fill_string" "noalloc"
+external unsafe_to_string : bytes -> string = "%identity"
+external unsafe_of_string : string -> bytes = "%identity"
+
+let make n c =
+  let s = create n in
+  unsafe_fill s 0 n c;
+  s
+
+let init n f =
+  let s = create n in
+  for i = 0 to n - 1 do
+    unsafe_set s i (f i)
+  done;
+  s
+
+let empty = create 0;;
+
+let copy s =
+  let len = length s in
+  let r = create len in
+  unsafe_blit s 0 r 0 len;
+  r
+
+let to_string b = unsafe_to_string (copy b)
+let of_string s = copy (unsafe_of_string s)
+
+let sub s ofs len =
+  if ofs < 0 || len < 0 || ofs > length s - len
+  then invalid_arg "Bytes.sub"
+  else begin
+    let r = create len in
+    unsafe_blit s ofs r 0 len;
+    r
+  end
+
+let sub_string b ofs len = unsafe_to_string (sub b ofs len)
+
+let fill s ofs len c =
+  if ofs < 0 || len < 0 || ofs > length s - len
+  then invalid_arg "Bytes.fill"
+  else unsafe_fill s ofs len c
+
+let blit s1 ofs1 s2 ofs2 len =
+  if len < 0 || ofs1 < 0 || ofs1 > length s1 - len
+             || ofs2 < 0 || ofs2 > length s2 - len
+  then invalid_arg "Bytes.blit"
+  else unsafe_blit s1 ofs1 s2 ofs2 len
+
+let iter f a =
+  for i = 0 to length a - 1 do f(unsafe_get a i) done
+
+let iteri f a =
+  for i = 0 to length a - 1 do f i (unsafe_get a i) done
+
+let concat sep l =
+  match l with
+    [] -> empty
+  | hd :: tl ->
+      let num = ref 0 and len = ref 0 in
+      List.iter (fun s -> incr num; len := !len + length s) l;
+      let r = create (!len + length sep * (!num - 1)) in
+      unsafe_blit hd 0 r 0 (length hd);
+      let pos = ref(length hd) in
+      List.iter
+        (fun s ->
+          unsafe_blit sep 0 r !pos (length sep);
+          pos := !pos + length sep;
+          unsafe_blit s 0 r !pos (length s);
+          pos := !pos + length s)
+        tl;
+      r
+
+external is_printable: char -> bool = "caml_is_printable"
+external char_code: char -> int = "%identity"
+external char_chr: int -> char = "%identity"
+
+let is_space = function
+  | ' ' | '\012' | '\n' | '\r' | '\t' -> true
+  | _ -> false
+
+let trim s =
+  let len = length s in
+  let i = ref 0 in
+  while !i < len && is_space (unsafe_get s !i) do
+    incr i
+  done;
+  let j = ref (len - 1) in
+  while !j >= !i && is_space (unsafe_get s !j) do
+    decr j
+  done;
+  if !j >= !i then
+    sub s !i (!j - !i + 1)
+  else
+    empty
+
+let escaped s =
+  let n = ref 0 in
+  for i = 0 to length s - 1 do
+    n := !n +
+      (match unsafe_get s i with
+       | '"' | '\\' | '\n' | '\t' | '\r' | '\b' -> 2
+       | c -> if is_printable c then 1 else 4)
+  done;
+  if !n = length s then copy s else begin
+    let s' = create !n in
+    n := 0;
+    for i = 0 to length s - 1 do
+      begin match unsafe_get s i with
+      | ('"' | '\\') as c ->
+          unsafe_set s' !n '\\'; incr n; unsafe_set s' !n c
+      | '\n' ->
+          unsafe_set s' !n '\\'; incr n; unsafe_set s' !n 'n'
+      | '\t' ->
+          unsafe_set s' !n '\\'; incr n; unsafe_set s' !n 't'
+      | '\r' ->
+          unsafe_set s' !n '\\'; incr n; unsafe_set s' !n 'r'
+      | '\b' ->
+          unsafe_set s' !n '\\'; incr n; unsafe_set s' !n 'b'
+      | c ->
+          if is_printable c then
+            unsafe_set s' !n c
+          else begin
+            let a = char_code c in
+            unsafe_set s' !n '\\';
+            incr n;
+            unsafe_set s' !n (char_chr (48 + a / 100));
+            incr n;
+            unsafe_set s' !n (char_chr (48 + (a / 10) mod 10));
+            incr n;
+            unsafe_set s' !n (char_chr (48 + a mod 10))
+          end
+      end;
+      incr n
+    done;
+    s'
+  end
+
+let map f s =
+  let l = length s in
+  if l = 0 then s else begin
+    let r = create l in
+    for i = 0 to l - 1 do unsafe_set r i (f (unsafe_get s i)) done;
+    r
+  end
+
+let mapi f s =
+  let l = length s in
+  if l = 0 then s else begin
+    let r = create l in
+    for i = 0 to l - 1 do unsafe_set r i (f i (unsafe_get s i)) done;
+    r
+  end
+
+let uppercase s = map Char.uppercase s
+let lowercase s = map Char.lowercase s
+
+let apply1 f s =
+  if length s = 0 then s else begin
+    let r = copy s in
+    unsafe_set r 0 (f(unsafe_get s 0));
+    r
+  end
+
+let capitalize s = apply1 Char.uppercase s
+let uncapitalize s = apply1 Char.lowercase s
+
+let rec index_rec s lim i c =
+  if i >= lim then raise Not_found else
+  if unsafe_get s i = c then i else index_rec s lim (i + 1) c;;
+
+let index s c = index_rec s (length s) 0 c;;
+
+let index_from s i c =
+  let l = length s in
+  if i < 0 || i > l then invalid_arg "Bytes.index_from" else
+  index_rec s l i c;;
+
+let rec rindex_rec s i c =
+  if i < 0 then raise Not_found else
+  if unsafe_get s i = c then i else rindex_rec s (i - 1) c;;
+
+let rindex s c = rindex_rec s (length s - 1) c;;
+
+let rindex_from s i c =
+  if i < -1 || i >= length s then invalid_arg "Bytes.rindex_from" else
+  rindex_rec s i c;;
+
+let contains_from s i c =
+  let l = length s in
+  if i < 0 || i > l then invalid_arg "Bytes.contains_from" else
+  try ignore (index_rec s l i c); true with Not_found -> false;;
+
+let contains s c = contains_from s 0 c;;
+
+let rcontains_from s i c =
+  if i < 0 || i >= length s then invalid_arg "Bytes.rcontains_from" else
+  try ignore (rindex_rec s i c); true with Not_found -> false;;
+
+type t = bytes
+
+let compare (x: t) (y: t) = Pervasives.compare x y
diff --git a/stdlib/bytes.mli b/stdlib/bytes.mli
new file mode 100644
index 0000000000..d9c1046740
--- /dev/null
+++ b/stdlib/bytes.mli
@@ -0,0 +1,238 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the GNU Library General Public License, with    *)
+(*  the special exception on linking described in file ../LICENSE.     *)
+(*                                                                     *)
+(***********************************************************************)
+
+(** Byte sequence operations.
+
+   A byte sequence is a mutable data structure that contains a
+   fixed-length sequence of bytes. Each byte can be indexed in
+   constant time for reading or writing.
+
+   Given a byte sequence [s] of length [l], we can access each of the
+   [l] bytes of [s] via its index in the sequence. Indexes start at
+   [0], and we will call an index valid in [s] if it falls within the
+   range [[0...l-1]] (inclusive). A position is the point between two
+   bytes or at the beginning or end of the sequence.  We call a
+   position valid in [s] if it falls within the range [[0...l]]
+   (inclusive). Note that the byte at index [n] is between positions
+   [n] and [n+1].
+
+   Two parameters [start] and [len] are said to designate a valid
+   range of [s] if [len >= 0] and [start] and [start+len] are valid
+   positions in [s].
+
+   Byte sequences can be modified in place, for instance via the [set]
+   and [blit] functions described below.  See also strings (module
+   {!String}), which are almost the same data structure, but cannot be
+   modified in place.
+
+   Bytes are represented by the OCaml type [char].
+
+   @since 4.02.0
+ *)
+
+external length : bytes -> int = "%string_length"
+(** Return the length (number of bytes) of the argument. *)
+
+external get : bytes -> int -> char = "%string_safe_get"
+(** [get s n] returns the byte at index [n] in argument [s].
+
+    Raise [Invalid_argument] if [n] not a valid index in [s]. *)
+
+external set : bytes -> int -> char -> unit = "%string_safe_set"
+(** [set s n c] modifies [s] in place, replacing the byte at index [n]
+    with [c].
+
+    Raise [Invalid_argument] if [n] is not a valid index in [s]. *)
+
+external create : int -> bytes = "caml_create_string"
+(** [create n] returns a new byte sequence of length [n]. The
+    sequence is uninitialized and contains arbitrary bytes.
+
+    Raise [Invalid_argument] if [n < 0] or [n > ]{!Sys.max_string_length}. *)
+
+val make : int -> char -> bytes
+(** [make n c] returns a new byte sequence of length [n], filled with
+    the byte [c].
+
+    Raise [Invalid_argument] if [n < 0] or [n > ]{!Sys.max_string_length}. *)
+
+val init : int -> (int -> char) -> bytes
+(** [Bytes.init n f] returns a fresh byte sequence of length [n], with
+    character [i] initialized to the result of [f i] (in increasing
+    index order).
+
+    Raise [Invalid_argument] if [n < 0] or [n > ]{!Sys.max_string_length}. *)
+
+val empty : bytes
+(** A byte sequence of size 0. *)
+
+val copy : bytes -> bytes
+(** Return a new byte sequence that contains the same bytes as the
+    argument. *)
+
+val of_string : string -> bytes
+(** Return a new byte sequence that contains the same bytes as the
+    given string. *)
+
+val to_string : bytes -> string
+(** Return a new string that contains the same bytes as the given byte
+    sequence. *)
+
+val sub : bytes -> int -> int -> bytes
+(** [sub s start len] returns a new byte sequence of length [len],
+    containing the subsequence of [s] that starts at position [start]
+    and has length [len].
+
+    Raise [Invalid_argument] if [start] and [len] do not designate a
+    valid range of [s]. *)
+
+val sub_string : bytes -> int -> int -> string
+(** Same as [sub] but return a string instead of a byte sequence. *)
+
+val fill : bytes -> int -> int -> char -> unit
+(** [fill s start len c] modifies [s] in place, replacing [len]
+    characters with [c], starting at [start].
+
+    Raise [Invalid_argument] if [start] and [len] do not designate a
+    valid range of [s]. *)
+
+val blit : bytes -> int -> bytes -> int -> int -> unit
+(** [blit src srcoff dst dstoff len] copies [len] bytes from sequence
+    [src], starting at index [srcoff], to sequence [dst], starting at
+    index [dstoff]. It works correctly even if [src] and [dst] are the
+    same byte sequence, and the source and destination intervals
+    overlap.
+
+    Raise [Invalid_argument] if [srcoff] and [len] do not
+    designate a valid range of [src], or if [dstoff] and [len]
+    do not designate a valid range of [dst]. *)
+
+val concat : bytes -> bytes list -> bytes
+(** [concat sep sl] concatenates the list of byte sequences [sl],
+    inserting the separator byte sequence [sep] between each, and
+    returns the result as a new byte sequence. *)
+
+val iter : (char -> unit) -> bytes -> unit
+(** [iter f s] applies function [f] in turn to all the bytes of [s].
+    It is equivalent to [f (get s 0); f (get s 1); ...; f (get s
+    (length s - 1)); ()]. *)
+
+val iteri : (int -> char -> unit) -> bytes -> unit
+(** Same as {!Bytes.iter}, but the function is applied to the index of
+    the byte as first argument and the byte itself as second
+    argument. *)
+
+val map : (char -> char) -> bytes -> bytes
+(** [map f s] applies function [f] in turn to all the bytes of [s]
+    (in increasing index order) and stores the resulting bytes in
+    a new sequence that is returned as the result. *)
+
+val mapi : (int -> char -> char) -> bytes -> bytes
+(** [mapi f s] calls [f] with each character of [s] and its
+    index (in increasing index order) and stores the resulting bytes
+    in a new sequence that is returned as the result. *)
+
+val trim : bytes -> bytes
+(** Return a copy of the argument, without leading and trailing
+    whitespace. The bytes regarded as whitespace are the ASCII
+    characters [' '], ['\012'], ['\n'], ['\r'], and ['\t']. *)
+
+val escaped : bytes -> bytes
+(** Return a copy of the argument, with special characters represented
+    by escape sequences, following the lexical conventions of OCaml. *)
+
+val index : bytes -> char -> int
+(** [index s c] returns the index of the first occurrence of byte [c]
+    in [s].
+
+    Raise [Not_found] if [c] does not occur in [s]. *)
+
+val rindex : bytes -> char -> int
+(** [rindex s c] returns the index of the last occurrence of byte [c]
+    in [s].
+
+    Raise [Not_found] if [c] does not occur in [s]. *)
+
+val index_from : bytes -> int -> char -> int
+(** [index_from s i c] returns the index of the first occurrence of
+    byte [c] in [s] after position [i].  [Bytes.index s c] is
+    equivalent to [Bytes.index_from s 0 c].
+
+    Raise [Invalid_argument] if [i] is not a valid position in [s].
+    Raise [Not_found] if [c] does not occur in [s] after position [i]. *)
+
+val rindex_from : bytes -> int -> char -> int
+(** [rindex_from s i c] returns the index of the last occurrence of
+    byte [c] in [s] before position [i+1].  [rindex s c] is equivalent
+    to [rindex_from s (Bytes.length s - 1) c].
+
+    Raise [Invalid_argument] if [i+1] is not a valid position in [s].
+    Raise [Not_found] if [c] does not occur in [s] before position [i+1]. *)
+
+val contains : bytes -> char -> bool
+(** [contains s c] tests if byte [c] appears in [s]. *)
+
+val contains_from : bytes -> int -> char -> bool
+(** [contains_from s start c] tests if byte [c] appears in [s] after
+    position [start].  [contains s c] is equivalent to [contains_from
+    s 0 c].
+
+    Raise [Invalid_argument] if [start] is not a valid position in [s]. *)
+
+val rcontains_from : bytes -> int -> char -> bool
+(** [rcontains_from s stop c] tests if byte [c] appears in [s] before
+    position [stop+1].
+
+    Raise [Invalid_argument] if [stop < 0] or [stop+1] is not a valid
+    position in [s]. *)
+
+val uppercase : bytes -> bytes
+(** Return a copy of the argument, with all lowercase letters
+    translated to uppercase, including accented letters of the ISO
+    Latin-1 (8859-1) character set. *)
+
+val lowercase : bytes -> bytes
+(** Return a copy of the argument, with all uppercase letters
+    translated to lowercase, including accented letters of the ISO
+    Latin-1 (8859-1) character set. *)
+
+val capitalize : bytes -> bytes
+(** Return a copy of the argument, with the first byte set to
+    uppercase. *)
+
+val uncapitalize : bytes -> bytes
+(** Return a copy of the argument, with the first byte set to
+    lowercase. *)
+
+type t = bytes
+(** An alias for the type of byte sequences. *)
+
+val compare: t -> t -> int
+(** The comparison function for byte sequences, with the same
+    specification as {!Pervasives.compare}.  Along with the type [t],
+    this function [compare] allows the module [Bytes] to be passed as
+    argument to the functors {!Set.Make} and {!Map.Make}. *)
+
+(**/**)
+
+(* The following is for system use only. Do not call directly. *)
+
+external unsafe_get : bytes -> int -> char = "%string_unsafe_get"
+external unsafe_set : bytes -> int -> char -> unit = "%string_unsafe_set"
+external unsafe_blit :
+  bytes -> int -> bytes -> int -> int -> unit
+  = "caml_blit_string" "noalloc"
+external unsafe_fill :
+  bytes -> int -> int -> char -> unit = "caml_fill_string" "noalloc"
+external unsafe_to_string : bytes -> string = "%identity"
+external unsafe_of_string : string -> bytes = "%identity"
diff --git a/stdlib/bytesLabels.ml b/stdlib/bytesLabels.ml
new file mode 100644
index 0000000000..8ec8ec9e10
--- /dev/null
+++ b/stdlib/bytesLabels.ml
@@ -0,0 +1,16 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*               Jacques Garrigue, Kyoto University RIMS               *)
+(*                                                                     *)
+(*  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.     *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* Module [BytesLabels]: labelled Bytes module *)
+
+include Bytes
diff --git a/stdlib/bytesLabels.mli b/stdlib/bytesLabels.mli
new file mode 100644
index 0000000000..23ccaf3911
--- /dev/null
+++ b/stdlib/bytesLabels.mli
@@ -0,0 +1,208 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the GNU Library General Public License, with    *)
+(*  the special exception on linking described in file ../LICENSE.     *)
+(*                                                                     *)
+(***********************************************************************)
+
+(** Byte sequence operations. *)
+
+external length : bytes -> int = "%string_length"
+(** Return the length (number of bytes) of the argument. *)
+
+external get : bytes -> int -> char = "%string_safe_get"
+(** [get s n] returns the byte at index [n] in argument [s].
+
+    Raise [Invalid_argument] if [n] not a valid index in [s]. *)
+
+
+external set : bytes -> int -> char -> unit = "%string_safe_set"
+(** [set s n c] modifies [s] in place, replacing the byte at index [n]
+    with [c].
+
+    Raise [Invalid_argument] if [n] is not a valid index in [s]. *)
+
+external create : int -> bytes = "caml_create_string"
+(** [create n] returns a new byte sequence of length [n]. The
+    sequence is uninitialized and contains arbitrary bytes.
+
+    Raise [Invalid_argument] if [n < 0] or [n > ]{!Sys.max_string_length}. *)
+
+val make : int -> char -> bytes
+(** [make n c] returns a new byte sequence of length [n], filled with
+    the byte [c].
+
+    Raise [Invalid_argument] if [n < 0] or [n > ]{!Sys.max_string_length}. *)
+
+val init : int -> f:(int -> char) -> bytes
+(** [init n f] returns a fresh byte sequence of length [n],
+    with character [i] initialized to the result of [f i].
+
+    Raise [Invalid_argument] if [n < 0] or [n > ]{!Sys.max_string_length}. *)
+
+val empty : bytes
+(** A byte sequence of size 0. *)
+
+val copy : bytes -> bytes
+(** Return a new byte sequence that contains the same bytes as the
+    argument. *)
+
+val of_string : string -> bytes
+(** Return a new byte sequence that contains the same bytes as the
+    given string. *)
+
+val to_string : bytes -> string
+(** Return a new string that contains the same bytes as the given byte
+    sequence. *)
+
+val sub : bytes -> pos:int -> len:int -> bytes
+(** [sub s start len] returns a new byte sequence of length [len],
+    containing the subsequence of [s] that starts at position [start]
+    and has length [len].
+
+    Raise [Invalid_argument] if [start] and [len] do not designate a
+    valid range of [s]. *)
+
+val sub_string : bytes -> int -> int -> string
+(** Same as [sub] but return a string instead of a byte sequence. *)
+
+val fill : bytes -> pos:int -> len:int -> char -> unit
+(** [fill s start len c] modifies [s] in place, replacing [len]
+    characters with [c], starting at [start].
+
+    Raise [Invalid_argument] if [start] and [len] do not designate a
+    valid range of [s]. *)
+
+val blit :
+  src:bytes -> src_pos:int -> dst:bytes -> dst_pos:int -> len:int
+  -> unit
+(** [blit src srcoff dst dstoff len] copies [len] bytes from sequence
+    [src], starting at index [srcoff], to sequence [dst], starting at
+    index [dstoff]. It works correctly even if [src] and [dst] are the
+    same byte sequence, and the source and destination intervals
+    overlap.
+
+    Raise [Invalid_argument] if [srcoff] and [len] do not
+    designate a valid range of [src], or if [dstoff] and [len]
+    do not designate a valid range of [dst]. *)
+
+val concat : sep:bytes -> bytes list -> bytes
+(** [concat sep sl] concatenates the list of byte sequences [sl],
+    inserting the separator byte sequence [sep] between each, and
+    returns the result as a new byte sequence. *)
+
+val iter : f:(char -> unit) -> bytes -> unit
+(** [iter f s] applies function [f] in turn to all the bytes of [s].
+    It is equivalent to [f (get s 0); f (get s 1); ...; f (get s
+    (length s - 1)); ()]. *)
+
+val iteri : f:(int -> char -> unit) -> bytes -> unit
+(** Same as {!Bytes.iter}, but the function is applied to the index of
+    the byte as first argument and the byte itself as second
+    argument. *)
+
+val map : f:(char -> char) -> bytes -> bytes
+(** [map f s] applies function [f] in turn to all the bytes of [s] and
+    stores the resulting bytes in a new sequence that is returned as
+    the result. *)
+
+val trim : bytes -> bytes
+(** Return a copy of the argument, without leading and trailing
+    whitespace. The bytes regarded as whitespace are the ASCII
+    characters [' '], ['\012'], ['\n'], ['\r'], and ['\t']. *)
+
+val escaped : bytes -> bytes
+(** Return a copy of the argument, with special characters represented
+    by escape sequences, following the lexical conventions of OCaml. *)
+
+val index : bytes -> char -> int
+(** [index s c] returns the index of the first occurrence of byte [c]
+    in [s].
+
+    Raise [Not_found] if [c] does not occur in [s]. *)
+
+val rindex : bytes -> char -> int
+(** [rindex s c] returns the index of the last occurrence of byte [c]
+    in [s].
+
+    Raise [Not_found] if [c] does not occur in [s]. *)
+
+val index_from : bytes -> int -> char -> int
+(** [index_from s i c] returns the index of the first occurrence of
+    byte [c] in [s] after position [i].  [Bytes.index s c] is
+    equivalent to [Bytes.index_from s 0 c].
+
+    Raise [Invalid_argument] if [i] is not a valid position in [s].
+    Raise [Not_found] if [c] does not occur in [s] after position [i]. *)
+
+val rindex_from : bytes -> int -> char -> int
+(** [rindex_from s i c] returns the index of the last occurrence of
+    byte [c] in [s] before position [i+1].  [rindex s c] is equivalent
+    to [rindex_from s (Bytes.length s - 1) c].
+
+    Raise [Invalid_argument] if [i+1] is not a valid position in [s].
+    Raise [Not_found] if [c] does not occur in [s] before position [i+1]. *)
+
+val contains : bytes -> char -> bool
+(** [contains s c] tests if byte [c] appears in [s]. *)
+
+val contains_from : bytes -> int -> char -> bool
+(** [contains_from s start c] tests if byte [c] appears in [s] after
+    position [start].  [contains s c] is equivalent to [contains_from
+    s 0 c].
+
+    Raise [Invalid_argument] if [start] is not a valid position in [s]. *)
+
+val rcontains_from : bytes -> int -> char -> bool
+(** [rcontains_from s stop c] tests if byte [c] appears in [s] before
+    position [stop+1].
+
+    Raise [Invalid_argument] if [stop < 0] or [stop+1] is not a valid
+    position in [s]. *)
+
+val uppercase : bytes -> bytes
+(** Return a copy of the argument, with all lowercase letters
+    translated to uppercase, including accented letters of the ISO
+    Latin-1 (8859-1) character set. *)
+
+val lowercase : bytes -> bytes
+(** Return a copy of the argument, with all uppercase letters
+    translated to lowercase, including accented letters of the ISO
+    Latin-1 (8859-1) character set. *)
+
+val capitalize : bytes -> bytes
+(** Return a copy of the argument, with the first byte set to
+    uppercase. *)
+
+val uncapitalize : bytes -> bytes
+(** Return a copy of the argument, with the first byte set to
+    lowercase. *)
+
+type t = bytes
+(** An alias for the type of byte sequences. *)
+
+val compare: t -> t -> int
+(** The comparison function for byte sequences, with the same
+    specification as {!Pervasives.compare}.  Along with the type [t],
+    this function [compare] allows the module [Bytes] to be passed as
+    argument to the functors {!Set.Make} and {!Map.Make}. *)
+
+(**/**)
+
+(* The following is for system use only. Do not call directly. *)
+
+external unsafe_get : bytes -> int -> char = "%string_unsafe_get"
+external unsafe_set : bytes -> int -> char -> unit = "%string_unsafe_set"
+external unsafe_blit :
+  src:bytes -> src_pos:int -> dst:bytes -> dst_pos:int -> len:int ->
+    unit = "caml_blit_string" "noalloc"
+external unsafe_fill :
+  bytes -> pos:int -> len:int -> char -> unit = "caml_fill_string" "noalloc"
+external unsafe_to_string : bytes -> string = "%identity"
+external unsafe_of_string : string -> bytes = "%identity"
diff --git a/stdlib/camlinternalFormat.ml b/stdlib/camlinternalFormat.ml
new file mode 100644
index 0000000000..f28e05f180
--- /dev/null
+++ b/stdlib/camlinternalFormat.ml
@@ -0,0 +1,2610 @@
+open CamlinternalFormatBasics
+
+let legacy_behavior = true
+(** When this flag is enabled, the format parser tries to behave as
+    the <4.02 implementations, in particular it ignores most benine
+    nonsensical format. When the flag is disabled, it will reject any
+    format that is not accepted by the specification.
+
+    A typical example would be "%+ d": specifying both '+' (if the
+    number is positive, pad with a '+' to get the same width as
+    negative numbres) and ' ' (if the number is positive, pad with
+    a space) does not make sense, but the legacy (< 4.02)
+    implementation was happy to just ignore the space.
+*)
+
+
+(******************************************************************************)
+           (* Tools to manipulate scanning set of chars (see %[...]) *)
+
+type mutable_char_set = bytes
+
+(* Create a fresh, empty, mutable char set. *)
+let create_char_set () = Bytes.make 32 '\000'
+
+(* Add a char in a mutable char set. *)
+let add_in_char_set char_set c =
+  let ind = int_of_char c in
+  let str_ind = ind lsr 3 and mask = 1 lsl (ind land 0b111) in
+  Bytes.set char_set str_ind
+    (char_of_int (int_of_char (Bytes.get char_set str_ind) lor mask))
+
+let freeze_char_set char_set =
+  Bytes.to_string char_set
+
+(* Compute the complement of a char set. *)
+let rev_char_set char_set =
+  let char_set' = create_char_set () in
+  for i = 0 to 31 do
+    Bytes.set char_set' i
+      (char_of_int (int_of_char (String.get char_set i) lxor 0xFF));
+  done;
+  Bytes.unsafe_to_string char_set'
+
+(* Return true if a `c' is in `char_set'. *)
+let is_in_char_set char_set c =
+  let ind = int_of_char c in
+  let str_ind = ind lsr 3 and mask = 1 lsl (ind land 0b111) in
+  (int_of_char (String.get char_set str_ind) land mask) <> 0
+
+
+(******************************************************************************)
+                         (* Ignored param conversion *)
+
+(* GADT used to abstract an existential type parameter. *)
+(* See param_format_of_ignored_format. *)
+type ('a, 'b, 'c, 'd, 'e, 'f) param_format_ebb = Param_format_EBB :
+    ('x -> 'a, 'b, 'c, 'd, 'e, 'f) fmt ->
+    ('a, 'b, 'c, 'd, 'e, 'f) param_format_ebb
+
+(* Compute a padding associated to a pad_option (see "%_42d"). *)
+let pad_of_pad_opt pad_opt = match pad_opt with
+  | None -> No_padding
+  | Some width -> Lit_padding (Right, width)
+
+(* Compute a precision associated to a prec_option (see "%_.42f"). *)
+let prec_of_prec_opt prec_opt = match prec_opt with
+  | None -> No_precision
+  | Some ndec -> Lit_precision ndec
+
+(* Turn an ignored param into its equivalent not-ignored format node. *)
+(* Used for format pretty-printing and Scanf. *)
+let param_format_of_ignored_format : type a b c d e f x y .
+    (a, b, c, d, y, x) ignored -> (x, b, c, y, e, f) fmt ->
+      (a, b, c, d, e, f) param_format_ebb =
+fun ign fmt -> match ign with
+  | Ignored_char ->
+    Param_format_EBB (Char fmt)
+  | Ignored_caml_char ->
+    Param_format_EBB (Caml_char fmt)
+  | Ignored_string pad_opt ->
+    Param_format_EBB (String (pad_of_pad_opt pad_opt, fmt))
+  | Ignored_caml_string pad_opt ->
+    Param_format_EBB (Caml_string (pad_of_pad_opt pad_opt, fmt))
+  | Ignored_int (iconv, pad_opt) ->
+    Param_format_EBB (Int (iconv, pad_of_pad_opt pad_opt, No_precision, fmt))
+  | Ignored_int32 (iconv, pad_opt) ->
+    Param_format_EBB
+      (Int32 (iconv, pad_of_pad_opt pad_opt, No_precision, fmt))
+  | Ignored_nativeint (iconv, pad_opt) ->
+    Param_format_EBB
+      (Nativeint (iconv, pad_of_pad_opt pad_opt, No_precision, fmt))
+  | Ignored_int64 (iconv, pad_opt) ->
+    Param_format_EBB
+      (Int64 (iconv, pad_of_pad_opt pad_opt, No_precision, fmt))
+  | Ignored_float (pad_opt, prec_opt) ->
+    Param_format_EBB
+      (Float (Float_f, pad_of_pad_opt pad_opt, prec_of_prec_opt prec_opt, fmt))
+  | Ignored_bool ->
+    Param_format_EBB (Bool fmt)
+  | Ignored_format_arg (pad_opt, fmtty) ->
+    Param_format_EBB (Format_arg (pad_opt, fmtty, fmt))
+  | Ignored_format_subst (pad_opt, fmtty) ->
+    Param_format_EBB
+      (Format_subst (pad_opt, fmtty, fmt))
+  | Ignored_reader ->
+    Param_format_EBB (Reader fmt)
+  | Ignored_scan_char_set (width_opt, char_set) ->
+    Param_format_EBB (Scan_char_set (width_opt, char_set, fmt))
+  | Ignored_scan_get_counter counter ->
+    Param_format_EBB (Scan_get_counter (counter, fmt))
+
+
+(******************************************************************************)
+                                 (* Types *)
+
+type ('b, 'c) acc_formatting_gen =
+  | Acc_open_tag of ('b, 'c) acc
+  | Acc_open_box of ('b, 'c) acc
+
+(* Reversed list of printing atoms. *)
+(* Used to accumulate printf arguments. *)
+and ('b, 'c) acc =
+  | Acc_formatting_lit of ('b, 'c) acc * formatting_lit(* Special fmtting (box) *)
+  | Acc_formatting_gen of ('b, 'c) acc * ('b, 'c) acc_formatting_gen (* Special fmtting (box) *)
+  | Acc_string         of ('b, 'c) acc * string        (* Literal or generated string*)
+  | Acc_char           of ('b, 'c) acc * char          (* Literal or generated char  *)
+  | Acc_delay          of ('b, 'c) acc * ('b -> 'c)    (* Delayed printing (%a, %t)  *)
+  | Acc_flush          of ('b, 'c) acc                 (* Flush                      *)
+  | Acc_invalid_arg    of ('b, 'c) acc * string        (* Raise Invalid_argument msg *)
+  | End_of_acc
+
+(* List of heterogeneous values. *)
+(* Used to accumulate scanf callback arguments. *)
+type ('a, 'b) heter_list =
+  | Cons : 'c * ('a, 'b) heter_list -> ('c -> 'a, 'b) heter_list
+  | Nil : ('b, 'b) heter_list
+
+(* Existential Black Boxes. *)
+(* Used to abstract some existential type parameters. *)
+
+(* GADT type associating a padding and an fmtty. *)
+(* See the type_padding function. *)
+type ('a, 'b, 'c, 'd, 'e, 'f) padding_fmtty_ebb = Padding_fmtty_EBB :
+     ('x, 'y) padding * ('y, 'b, 'c, 'd, 'e, 'f) fmtty ->
+     ('x, 'b, 'c, 'd, 'e, 'f) padding_fmtty_ebb
+
+(* GADT type associating a padding, a precision and an fmtty. *)
+(* See the type_padprec function. *)
+type ('a, 'b, 'c, 'd, 'e, 'f) padprec_fmtty_ebb = Padprec_fmtty_EBB :
+     ('x, 'y) padding * ('y, 'z) precision * ('z, 'b, 'c, 'd, 'e, 'f) fmtty ->
+     ('x, 'b, 'c, 'd, 'e, 'f) padprec_fmtty_ebb
+
+(* GADT type associating a padding and an fmt. *)
+(* See make_padding_fmt_ebb and parse_format functions. *)
+type ('a, 'b, 'c, 'e, 'f) padding_fmt_ebb = Padding_fmt_EBB :
+     (_, 'x -> 'a) padding *
+     ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+     ('x, 'b, 'c, 'e, 'f) padding_fmt_ebb
+
+(* GADT type associating a precision and an fmt. *)
+(* See make_precision_fmt_ebb and parse_format functions. *)
+type ('a, 'b, 'c, 'e, 'f) precision_fmt_ebb = Precision_fmt_EBB :
+     (_, 'x -> 'a) precision *
+     ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+     ('x, 'b, 'c, 'e, 'f) precision_fmt_ebb
+
+(* GADT type associating a padding, a precision and an fmt. *)
+(* See make_padprec_fmt_ebb and parse_format functions. *)
+type ('p, 'b, 'c, 'e, 'f) padprec_fmt_ebb = Padprec_fmt_EBB :
+     ('x, 'y) padding * ('y, 'p -> 'a) precision *
+     ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+     ('p, 'b, 'c, 'e, 'f) padprec_fmt_ebb
+
+(* Abstract the 'a and 'd parameters of an fmt. *)
+(* Output type of the format parsing function. *)
+type ('b, 'c, 'e, 'f) fmt_ebb = Fmt_EBB :
+     ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+     ('b, 'c, 'e, 'f) fmt_ebb
+
+(* GADT type associating an fmtty and an fmt. *)
+(* See the type_format_gen function. *)
+type ('a, 'b, 'c, 'd, 'e, 'f) fmt_fmtty_ebb = Fmt_fmtty_EBB :
+     ('a, 'b, 'c, 'd, 'y, 'x) fmt *
+     ('x, 'b, 'c, 'y, 'e, 'f) fmtty ->
+     ('a, 'b, 'c, 'd, 'e, 'f) fmt_fmtty_ebb
+
+(* GADT type associating an fmtty and an fmt. *)
+(* See the type_ignored_format_substitution function. *)
+type ('a, 'b, 'c, 'd, 'e, 'f) fmtty_fmt_ebb = Fmtty_fmt_EBB :
+     ('a, 'b, 'c, 'd, 'y, 'x) fmtty *
+     ('x, 'b, 'c, 'y, 'e, 'f) fmt_fmtty_ebb ->
+     ('a, 'b, 'c, 'd, 'e, 'f) fmtty_fmt_ebb
+
+(* Abstract all fmtty type parameters. *)
+(* Used to compare format types. *)
+type fmtty_ebb = Fmtty_EBB : ('a, 'b, 'c, 'd, 'e, 'f) fmtty -> fmtty_ebb
+
+(* Abstract all padding type parameters. *)
+(* Used to compare paddings. *)
+type padding_ebb = Padding_EBB : ('a, 'b) padding -> padding_ebb
+
+(* Abstract all precision type parameters. *)
+(* Used to compare precisions. *)
+type precision_ebb = Precision_EBB : ('a, 'b) precision -> precision_ebb
+
+(******************************************************************************)
+                               (* Constants *)
+
+(* Default precision for float printing. *)
+let default_float_precision = 6
+
+(******************************************************************************)
+                               (* Externals *)
+
+external format_float: string -> float -> string
+  = "caml_format_float"
+external format_int: string -> int -> string
+  = "caml_format_int"
+external format_int32: string -> int32 -> string
+  = "caml_int32_format"
+external format_nativeint: string -> nativeint -> string
+  = "caml_nativeint_format"
+external format_int64: string -> int64 -> string
+  = "caml_int64_format"
+
+(******************************************************************************)
+                     (* Tools to pretty-print formats *)
+
+(* Type of extensible character buffers. *)
+type buffer = {
+  mutable ind : int;
+  mutable bytes : bytes;
+}
+
+(* Create a fresh buffer. *)
+let buffer_create init_size = { ind = 0; bytes = Bytes.create init_size }
+
+(* Check size of the buffer and grow it if needed. *)
+let buffer_check_size buf overhead =
+  let len = Bytes.length buf.bytes in
+  let min_len = buf.ind + overhead in
+  if min_len > len then (
+    let new_len = max (len * 2) min_len in
+    let new_str = Bytes.create new_len in
+    Bytes.blit buf.bytes 0 new_str 0 len;
+    buf.bytes <- new_str;
+  )
+
+(* Add the character `c' to the buffer `buf'. *)
+let buffer_add_char buf c =
+  buffer_check_size buf 1;
+  Bytes.set buf.bytes buf.ind c;
+  buf.ind <- buf.ind + 1
+
+(* Add the string `s' to the buffer `buf'. *)
+let buffer_add_string buf s =
+  let str_len = String.length s in
+  buffer_check_size buf str_len;
+  String.blit s 0 buf.bytes buf.ind str_len;
+  buf.ind <- buf.ind + str_len
+
+(* Get the content of the buffer. *)
+let buffer_contents buf =
+  Bytes.sub_string buf.bytes 0 buf.ind
+
+(***)
+
+(* Convert an integer conversion to char. *)
+let char_of_iconv iconv = match iconv with
+  | Int_d | Int_pd | Int_sd -> 'd' | Int_i | Int_pi | Int_si -> 'i'
+  | Int_x | Int_Cx -> 'x' | Int_X | Int_CX -> 'X' | Int_o | Int_Co -> 'o'
+  | Int_u -> 'u'
+
+(* Convert a float conversion to char. *)
+let char_of_fconv fconv = match fconv with
+  | Float_f | Float_pf | Float_sf -> 'f' | Float_e | Float_pe | Float_se -> 'e'
+  | Float_E | Float_pE | Float_sE -> 'E' | Float_g | Float_pg | Float_sg -> 'g'
+  | Float_G | Float_pG | Float_sG -> 'G' | Float_F -> 'F'
+
+(* Convert a scanning counter to char. *)
+let char_of_counter counter = match counter with
+  | Line_counter  -> 'l'
+  | Char_counter  -> 'n'
+  | Token_counter -> 'N'
+
+(***)
+
+(* Print a char_set in a buffer with the OCaml format lexical convention. *)
+let bprint_char_set buf char_set =
+  let rec print_start set =
+    let is_alone c =
+      let before, after = Char.(chr (code c - 1), chr (code c + 1)) in
+      is_in_char_set set c
+      && not (is_in_char_set set before && is_in_char_set set after) in
+    if is_alone ']' then buffer_add_char buf ']';
+    print_out set 1;
+    if is_alone '-' then buffer_add_char buf '-';
+  and print_out set i =
+    if i < 256 then
+      if is_in_char_set set (char_of_int i) then print_first set i
+      else print_out set (i + 1)
+  and print_first set i =
+    match char_of_int i with
+    | '\255' -> print_char buf 255;
+    | ']' | '-' -> print_out set (i + 1);
+    | _ -> print_second set (i + 1);
+  and print_second set i =
+    if is_in_char_set set (char_of_int i) then
+      match char_of_int i with
+      | '\255' ->
+        print_char buf 254;
+        print_char buf 255;
+      | ']' | '-' when not (is_in_char_set set (char_of_int (i + 1))) ->
+        print_char buf (i - 1);
+        print_out set (i + 1);
+      | _ when not (is_in_char_set set (char_of_int (i + 1))) ->
+        print_char buf (i - 1);
+        print_char buf i;
+        print_out set (i + 2);
+      | _ ->
+        print_in set (i - 1) (i + 2);
+    else (
+      print_char buf (i - 1);
+      print_out set (i + 1);
+    )
+  and print_in set i j =
+    if j = 256 || not (is_in_char_set set (char_of_int j)) then (
+      print_char buf i;
+      print_char buf (int_of_char '-');
+      print_char buf (j - 1);
+      if j < 256 then print_out set (j + 1);
+    ) else
+      print_in set i (j + 1);
+  and print_char buf i = match char_of_int i with
+    | '%' -> buffer_add_char buf '%'; buffer_add_char buf '%';
+    | '@' -> buffer_add_char buf '%'; buffer_add_char buf '@';
+    | c   -> buffer_add_char buf c;
+  in
+  buffer_add_char buf '[';
+  print_start (
+    if is_in_char_set char_set '\000'
+    then ( buffer_add_char buf '^'; rev_char_set char_set )
+    else char_set
+  );
+  buffer_add_char buf ']'
+
+(***)
+
+(* Print a padty in a buffer with the format-like syntax. *)
+let bprint_padty buf padty = match padty with
+  | Left  -> buffer_add_char buf '-'
+  | Right -> ()
+  | Zeros -> buffer_add_char buf '0'
+
+(* Print the '_' of an ignored flag if needed. *)
+let bprint_ignored_flag buf ign_flag =
+  if ign_flag then buffer_add_char buf '_'
+
+(***)
+
+let bprint_pad_opt buf pad_opt = match pad_opt with
+  | None -> ()
+  | Some width -> buffer_add_string buf (string_of_int width)
+
+(***)
+
+(* Print padding in a buffer with the format-like syntax. *)
+let bprint_padding : type a b . buffer -> (a, b) padding -> unit =
+fun buf pad -> match pad with
+  | No_padding -> ()
+  | Lit_padding (padty, n) ->
+    bprint_padty buf padty;
+    buffer_add_string buf (string_of_int n);
+  | Arg_padding padty ->
+    bprint_padty buf padty;
+    buffer_add_char buf '*'
+
+(* Print precision in a buffer with the format-like syntax. *)
+let bprint_precision : type a b . buffer -> (a, b) precision -> unit =
+  fun buf prec -> match prec with
+  | No_precision -> ()
+  | Lit_precision n ->
+    buffer_add_char buf '.';
+    buffer_add_string buf (string_of_int n);
+  | Arg_precision ->
+    buffer_add_string buf ".*"
+
+(***)
+
+(* Print the optionnal '+', ' ' or '#' associated to an int conversion. *)
+let bprint_iconv_flag buf iconv = match iconv with
+  | Int_pd | Int_pi -> buffer_add_char buf '+'
+  | Int_sd | Int_si -> buffer_add_char buf ' '
+  | Int_Cx | Int_CX | Int_Co -> buffer_add_char buf '#'
+  | Int_d | Int_i | Int_x | Int_X | Int_o | Int_u -> ()
+
+(* Print an complete int format in a buffer (ex: "%3.*d"). *)
+let bprint_int_fmt buf ign_flag iconv pad prec =
+  buffer_add_char buf '%';
+  bprint_ignored_flag buf ign_flag;
+  bprint_iconv_flag buf iconv;
+  bprint_padding buf pad;
+  bprint_precision buf prec;
+  buffer_add_char buf (char_of_iconv iconv)
+
+(* Print a complete int32, nativeint or int64 format in a buffer. *)
+let bprint_altint_fmt buf ign_flag iconv pad prec c =
+  buffer_add_char buf '%';
+  bprint_ignored_flag buf ign_flag;
+  bprint_iconv_flag buf iconv;
+  bprint_padding buf pad;
+  bprint_precision buf prec;
+  buffer_add_char buf c;
+  buffer_add_char buf (char_of_iconv iconv)
+
+(***)
+
+(* Print the optionnal '+' associated to a float conversion. *)
+let bprint_fconv_flag buf fconv = match fconv with
+  | Float_pf | Float_pe | Float_pE | Float_pg | Float_pG ->
+    buffer_add_char buf '+'
+  | Float_sf | Float_se | Float_sE | Float_sg | Float_sG ->
+    buffer_add_char buf ' '
+  | Float_f | Float_e | Float_E | Float_g | Float_G | Float_F ->
+    ()
+
+(* Print a complete float format in a buffer (ex: "%+*.3f"). *)
+let bprint_float_fmt buf ign_flag fconv pad prec =
+  buffer_add_char buf '%';
+  bprint_ignored_flag buf ign_flag;
+  bprint_fconv_flag buf fconv;
+  bprint_padding buf pad;
+  bprint_precision buf prec;
+  buffer_add_char buf (char_of_fconv fconv)
+
+(* Compute the literal string representation of a formatting_lit. *)
+(* Also used by Printf and Scanf where formatting is not interpreted. *)
+let string_of_formatting_lit formatting_lit = match formatting_lit with
+  | Close_box            -> "@]"
+  | Close_tag            -> "@}"
+  | Break (str, _, _)    -> str
+  | FFlush               -> "@?"
+  | Force_newline        -> "@\n"
+  | Flush_newline        -> "@."
+  | Magic_size (str, _)  -> str
+  | Escaped_at           -> "@@"
+  | Escaped_percent      -> "@%"
+  | Scan_indic c -> "@" ^ (String.make 1 c)
+
+(* Compute the literal string representation of a formatting. *)
+(* Also used by Printf and Scanf where formatting is not interpreted. *)
+let string_of_formatting_gen : type a b c d e f .
+    (a, b, c, d, e, f) formatting_gen -> string =
+  fun formatting_gen -> match formatting_gen with
+  | Open_tag (Format (_, str)) -> str
+  | Open_box (Format (_, str)) -> str
+
+(***)
+
+(* Print a literal char in a buffer, escape '%' by "%%". *)
+let bprint_char_literal buf chr = match chr with
+  | '%' -> buffer_add_string buf "%%"
+  | _ -> buffer_add_char buf chr
+
+(* Print a literal string in a buffer, escape all '%' by "%%". *)
+let bprint_string_literal buf str =
+  for i = 0 to String.length str - 1 do
+    bprint_char_literal buf str.[i]
+  done
+
+(******************************************************************************)
+                          (* Format pretty-printing *)
+
+(* Print a complete format type (an fmtty) in a buffer. *)
+let rec bprint_fmtty : type a b c d e f g h i j k l .
+    buffer -> (a, b, c, d, e, f, g, h, i, j, k, l) fmtty_rel -> unit =
+fun buf fmtty -> match fmtty with
+  | Char_ty rest      -> buffer_add_string buf "%c";  bprint_fmtty buf rest;
+  | String_ty rest    -> buffer_add_string buf "%s";  bprint_fmtty buf rest;
+  | Int_ty rest       -> buffer_add_string buf "%i";  bprint_fmtty buf rest;
+  | Int32_ty rest     -> buffer_add_string buf "%li"; bprint_fmtty buf rest;
+  | Nativeint_ty rest -> buffer_add_string buf "%ni"; bprint_fmtty buf rest;
+  | Int64_ty rest     -> buffer_add_string buf "%Li"; bprint_fmtty buf rest;
+  | Float_ty rest     -> buffer_add_string buf "%f";  bprint_fmtty buf rest;
+  | Bool_ty rest      -> buffer_add_string buf "%B";  bprint_fmtty buf rest;
+  | Alpha_ty rest     -> buffer_add_string buf "%a";  bprint_fmtty buf rest;
+  | Theta_ty rest     -> buffer_add_string buf "%t";  bprint_fmtty buf rest;
+  | Reader_ty rest    -> buffer_add_string buf "%r";  bprint_fmtty buf rest;
+
+  | Ignored_reader_ty rest ->
+    buffer_add_string buf "%_r";
+    bprint_fmtty buf rest;
+
+  | Format_arg_ty (sub_fmtty, rest) ->
+    buffer_add_string buf "%{"; bprint_fmtty buf sub_fmtty;
+    buffer_add_string buf "%}"; bprint_fmtty buf rest;
+  | Format_subst_ty (sub_fmtty, _, rest) ->
+    buffer_add_string buf "%("; bprint_fmtty buf sub_fmtty;
+    buffer_add_string buf "%)"; bprint_fmtty buf rest;
+
+  | End_of_fmtty -> ()
+
+(***)
+
+(* Print a complete format in a buffer. *)
+let bprint_fmt buf fmt =
+  let rec fmtiter : type a b c d e f .
+      (a, b, c, d, e, f) fmt -> bool -> unit =
+  fun fmt ign_flag -> match fmt with
+    | String (pad, rest) ->
+      buffer_add_char buf '%'; bprint_ignored_flag buf ign_flag;
+      bprint_padding buf pad; buffer_add_char buf 's';
+      fmtiter rest false;
+    | Caml_string (pad, rest) ->
+      buffer_add_char buf '%'; bprint_ignored_flag buf ign_flag;
+      bprint_padding buf pad; buffer_add_char buf 'S';
+      fmtiter rest false;
+
+    | Int (iconv, pad, prec, rest) ->
+      bprint_int_fmt buf ign_flag iconv pad prec;
+      fmtiter rest false;
+    | Int32 (iconv, pad, prec, rest) ->
+      bprint_altint_fmt buf ign_flag iconv pad prec 'l';
+      fmtiter rest false;
+    | Nativeint (iconv, pad, prec, rest) ->
+      bprint_altint_fmt buf ign_flag iconv pad prec 'n';
+      fmtiter rest false;
+    | Int64 (iconv, pad, prec, rest) ->
+      bprint_altint_fmt buf ign_flag iconv pad prec 'L';
+      fmtiter rest false;
+    | Float (fconv, pad, prec, rest) ->
+      bprint_float_fmt buf ign_flag fconv pad prec;
+      fmtiter rest false;
+
+    | Char rest ->
+      buffer_add_char buf '%'; bprint_ignored_flag buf ign_flag;
+      buffer_add_char buf 'c'; fmtiter rest false;
+    | Caml_char rest ->
+      buffer_add_char buf '%'; bprint_ignored_flag buf ign_flag;
+      buffer_add_char buf 'C'; fmtiter rest false;
+    | Bool rest ->
+      buffer_add_char buf '%'; bprint_ignored_flag buf ign_flag;
+      buffer_add_char buf 'B'; fmtiter rest false;
+    | Alpha rest ->
+      buffer_add_char buf '%'; bprint_ignored_flag buf ign_flag;
+      buffer_add_char buf 'a'; fmtiter rest false;
+    | Theta rest ->
+      buffer_add_char buf '%'; bprint_ignored_flag buf ign_flag;
+      buffer_add_char buf 't'; fmtiter rest false;
+    | Reader rest ->
+      buffer_add_char buf '%'; bprint_ignored_flag buf ign_flag;
+      buffer_add_char buf 'r'; fmtiter rest false;
+    | Flush rest ->
+      buffer_add_string buf "%!";
+      fmtiter rest ign_flag;
+
+    | String_literal (str, rest) ->
+      bprint_string_literal buf str;
+      fmtiter rest ign_flag;
+    | Char_literal (chr, rest) ->
+      bprint_char_literal buf chr;
+      fmtiter rest ign_flag;
+
+    | Format_arg (pad_opt, fmtty, rest) ->
+      buffer_add_char buf '%'; bprint_ignored_flag buf ign_flag;
+      bprint_pad_opt buf pad_opt; buffer_add_char buf '{';
+      bprint_fmtty buf fmtty; buffer_add_char buf '%'; buffer_add_char buf '}';
+      fmtiter rest false;
+    | Format_subst (pad_opt, fmtty, rest) ->
+      buffer_add_char buf '%'; bprint_ignored_flag buf ign_flag;
+      bprint_pad_opt buf pad_opt; buffer_add_char buf '(';
+      bprint_fmtty buf fmtty; buffer_add_char buf '%'; buffer_add_char buf ')';
+      fmtiter rest false;
+
+    | Scan_char_set (width_opt, char_set, rest) ->
+      buffer_add_char buf '%'; bprint_ignored_flag buf ign_flag;
+      bprint_pad_opt buf width_opt; bprint_char_set buf char_set;
+      fmtiter rest false;
+    | Scan_get_counter (counter, rest) ->
+      buffer_add_char buf '%'; bprint_ignored_flag buf ign_flag;
+      buffer_add_char buf (char_of_counter counter);
+      fmtiter rest false;
+    | Ignored_param (ign, rest) ->
+      let Param_format_EBB fmt' = param_format_of_ignored_format ign rest in
+      fmtiter fmt' true;
+
+    | Formatting_lit (fmting_lit, rest) ->
+      bprint_string_literal buf (string_of_formatting_lit fmting_lit);
+      fmtiter rest ign_flag;
+    | Formatting_gen (fmting_gen, rest) ->
+      bprint_string_literal buf "@{";
+      bprint_string_literal buf (string_of_formatting_gen fmting_gen);
+      fmtiter rest ign_flag;
+
+    | End_of_format -> ()
+
+  in fmtiter fmt false
+
+(***)
+
+(* Convert a format to string. *)
+let string_of_fmt fmt =
+  let buf = buffer_create 16 in
+  bprint_fmt buf fmt;
+  buffer_contents buf
+
+(******************************************************************************)
+                          (* Type extraction *)
+
+type (_, _) eq = Refl : ('a, 'a) eq
+
+(* Invariant: this function is the identity on values.
+
+   In particular, if (ty1, ty2) have equal values, then
+   (trans (symm ty1) ty2) respects the 'trans' precondition. *)
+let rec symm : type a1 b1 c1 d1 e1 f1 a2 b2 c2 d2 e2 f2 .
+   (a1, b1, c1, d1, e1, f1,
+    a2, b2, c2, d2, e2, f2) fmtty_rel
+-> (a2, b2, c2, d2, e2, f2,
+    a1, b1, c1, d1, e1, f1) fmtty_rel
+= function
+  | Char_ty rest -> Char_ty (symm rest)
+  | Int_ty rest -> Int_ty (symm rest)
+  | Int32_ty rest -> Int32_ty (symm rest)
+  | Int64_ty rest -> Int64_ty (symm rest)
+  | Nativeint_ty rest -> Nativeint_ty (symm rest)
+  | Float_ty rest -> Float_ty (symm rest)
+  | Bool_ty rest -> Bool_ty (symm rest)
+  | String_ty rest -> String_ty (symm rest)
+  | Theta_ty rest -> Theta_ty (symm rest)
+  | Alpha_ty rest -> Alpha_ty (symm rest)
+  | Reader_ty rest -> Reader_ty (symm rest)
+  | Ignored_reader_ty rest -> Ignored_reader_ty (symm rest)
+  | Format_arg_ty (ty, rest) ->
+    Format_arg_ty (ty, symm rest)
+  | Format_subst_ty (ty1, ty2, rest) ->
+    Format_subst_ty (ty2, ty1, symm rest)
+  | End_of_fmtty -> End_of_fmtty
+
+let rec fmtty_rel_det : type a1 b c d1 e1 f1 a2 d2 e2 f2 .
+  (a1, b, c, d1, e1, f1,
+   a2, b, c, d2, e2, f2) fmtty_rel ->
+    ((f1, f2) eq -> (a1, a2) eq)
+  * ((a1, a2) eq -> (f1, f2) eq)
+  * ((e1, e2) eq -> (d1, d2) eq)
+  * ((d1, d2) eq -> (e1, e2) eq)
+= function
+  | End_of_fmtty ->
+    (fun Refl -> Refl),
+    (fun Refl -> Refl),
+    (fun Refl -> Refl),
+    (fun Refl -> Refl)
+  | Char_ty rest ->
+    let fa, af, ed, de = fmtty_rel_det rest in
+    (fun Refl -> let Refl = fa Refl in Refl),
+    (fun Refl -> let Refl = af Refl in Refl),
+    ed, de
+  | String_ty rest ->
+    let fa, af, ed, de = fmtty_rel_det rest in
+    (fun Refl -> let Refl = fa Refl in Refl),
+    (fun Refl -> let Refl = af Refl in Refl),
+    ed, de
+  | Int_ty rest ->
+    let fa, af, ed, de = fmtty_rel_det rest in
+    (fun Refl -> let Refl = fa Refl in Refl),
+    (fun Refl -> let Refl = af Refl in Refl),
+    ed, de
+  | Int32_ty rest ->
+    let fa, af, ed, de = fmtty_rel_det rest in
+    (fun Refl -> let Refl = fa Refl in Refl),
+    (fun Refl -> let Refl = af Refl in Refl),
+    ed, de
+  | Int64_ty rest ->
+    let fa, af, ed, de = fmtty_rel_det rest in
+    (fun Refl -> let Refl = fa Refl in Refl),
+    (fun Refl -> let Refl = af Refl in Refl),
+    ed, de
+  | Nativeint_ty rest ->
+    let fa, af, ed, de = fmtty_rel_det rest in
+    (fun Refl -> let Refl = fa Refl in Refl),
+    (fun Refl -> let Refl = af Refl in Refl),
+    ed, de
+  | Float_ty rest ->
+    let fa, af, ed, de = fmtty_rel_det rest in
+    (fun Refl -> let Refl = fa Refl in Refl),
+    (fun Refl -> let Refl = af Refl in Refl),
+    ed, de
+  | Bool_ty rest ->
+    let fa, af, ed, de = fmtty_rel_det rest in
+    (fun Refl -> let Refl = fa Refl in Refl),
+    (fun Refl -> let Refl = af Refl in Refl),
+    ed, de
+
+  | Theta_ty rest ->
+    let fa, af, ed, de = fmtty_rel_det rest in
+    (fun Refl -> let Refl = fa Refl in Refl),
+    (fun Refl -> let Refl = af Refl in Refl),
+    ed, de
+  | Alpha_ty rest ->
+    let fa, af, ed, de = fmtty_rel_det rest in
+    (fun Refl -> let Refl = fa Refl in Refl),
+    (fun Refl -> let Refl = af Refl in Refl),
+    ed, de
+  | Reader_ty rest ->
+    let fa, af, ed, de = fmtty_rel_det rest in
+    (fun Refl -> let Refl = fa Refl in Refl),
+    (fun Refl -> let Refl = af Refl in Refl),
+    (fun Refl -> let Refl = ed Refl in Refl),
+    (fun Refl -> let Refl = de Refl in Refl)
+  | Ignored_reader_ty rest ->
+    let fa, af, ed, de = fmtty_rel_det rest in
+    (fun Refl -> let Refl = fa Refl in Refl),
+    (fun Refl -> let Refl = af Refl in Refl),
+    (fun Refl -> let Refl = ed Refl in Refl),
+    (fun Refl -> let Refl = de Refl in Refl)
+  | Format_arg_ty (_ty, rest) ->
+    let fa, af, ed, de = fmtty_rel_det rest in
+    (fun Refl -> let Refl = fa Refl in Refl),
+    (fun Refl -> let Refl = af Refl in Refl),
+    ed, de
+  | Format_subst_ty (ty1, ty2, rest) ->
+    let fa, af, ed, de = fmtty_rel_det rest in
+    let ty = trans (symm ty1) ty2 in
+    let ag, ga, dj, jd = fmtty_rel_det ty in
+    (fun Refl -> let Refl = fa Refl in let Refl = ag Refl in Refl),
+    (fun Refl -> let Refl = ga Refl in let Refl = af Refl in Refl),
+    (fun Refl -> let Refl = ed Refl in let Refl = dj Refl in Refl),
+    (fun Refl -> let Refl = jd Refl in let Refl = de Refl in Refl)
+
+(* Precondition: we assume that the two fmtty_rel arguments have equal
+   values (at possibly distinct types); this invariant comes from the way
+   fmtty_rel witnesses are produced by the type-checker
+
+   The code below uses (assert false) when this assumption is broken. The
+   code pattern is the following:
+
+     | Foo x, Foo y ->
+       (* case where indeed both values
+          start with constructor Foo *)
+     | Foo _, _
+     | _, Foo _ ->
+       (* different head constructors: broken precondition *)
+       assert false
+*)
+and trans : type
+  a1 b1 c1 d1 e1 f1
+  a2 b2 c2 d2 e2 f2
+  a3 b3 c3 d3 e3 f3
+.
+   (a1, b1, c1, d1, e1, f1,
+    a2, b2, c2, d2, e2, f2) fmtty_rel
+-> (a2, b2, c2, d2, e2, f2,
+    a3, b3, c3, d3, e3, f3) fmtty_rel
+-> (a1, b1, c1, d1, e1, f1,
+    a3, b3, c3, d3, e3, f3) fmtty_rel
+= fun ty1 ty2 -> match ty1, ty2 with
+  | Char_ty rest1, Char_ty rest2 -> Char_ty (trans rest1 rest2)
+  | String_ty rest1, String_ty rest2 -> String_ty (trans rest1 rest2)
+  | Bool_ty rest1, Bool_ty rest2 -> Bool_ty (trans rest1 rest2)
+  | Int_ty rest1, Int_ty rest2 -> Int_ty (trans rest1 rest2)
+  | Int32_ty rest1, Int32_ty rest2 -> Int32_ty (trans rest1 rest2)
+  | Int64_ty rest1, Int64_ty rest2 -> Int64_ty (trans rest1 rest2)
+  | Nativeint_ty rest1, Nativeint_ty rest2 -> Nativeint_ty (trans rest1 rest2)
+  | Float_ty rest1, Float_ty rest2 -> Float_ty (trans rest1 rest2)
+
+  | Alpha_ty rest1, Alpha_ty rest2 -> Alpha_ty (trans rest1 rest2)
+  | Alpha_ty _, _ -> assert false
+  | _, Alpha_ty _ -> assert false
+
+  | Theta_ty rest1, Theta_ty rest2 -> Theta_ty (trans rest1 rest2)
+  | Theta_ty _, _ -> assert false
+  | _, Theta_ty _ -> assert false
+
+  | Reader_ty rest1, Reader_ty rest2 -> Reader_ty (trans rest1 rest2)
+  | Reader_ty _, _ -> assert false
+  | _, Reader_ty _ -> assert false
+
+  | Ignored_reader_ty rest1, Ignored_reader_ty rest2 ->
+    Ignored_reader_ty (trans rest1 rest2)
+  | Ignored_reader_ty _, _ -> assert false
+  | _, Ignored_reader_ty _ -> assert false
+
+  | Format_arg_ty (ty1, rest1), Format_arg_ty (ty2, rest2) ->
+    Format_arg_ty (trans ty1 ty2, trans rest1 rest2)
+  | Format_arg_ty _, _ -> assert false
+  | _, Format_arg_ty _ -> assert false
+
+  | Format_subst_ty (ty11, ty12, rest1),
+    Format_subst_ty (ty21, ty22, rest2) ->
+    let ty = trans (symm ty12) ty21 in
+    let _, f2, _, f4 = fmtty_rel_det ty in
+    let Refl = f2 Refl in
+    let Refl = f4 Refl in
+    Format_subst_ty (ty11, ty22, trans rest1 rest2)
+  | Format_subst_ty _, _ -> assert false
+  | _, Format_subst_ty _ -> assert false
+
+  | End_of_fmtty, End_of_fmtty -> End_of_fmtty
+  | End_of_fmtty, _ -> assert false
+  | _, End_of_fmtty -> assert false
+
+let rec fmtty_of_formatting_gen : type a b c d e f .
+  (a, b, c, d, e, f) formatting_gen ->
+    (a, b, c, d, e, f) fmtty =
+fun formatting_gen -> match formatting_gen with
+  | Open_tag (Format (fmt, _)) -> fmtty_of_fmt fmt
+  | Open_box (Format (fmt, _)) -> fmtty_of_fmt fmt
+
+(* Extract the type representation (an fmtty) of a format. *)
+and fmtty_of_fmt : type a b c d e f .
+  (a, b, c, d, e, f) fmt -> (a, b, c, d, e, f) fmtty =
+fun fmtty -> match fmtty with
+  | String (pad, rest) ->
+    fmtty_of_padding_fmtty pad (String_ty (fmtty_of_fmt rest))
+  | Caml_string (pad, rest) ->
+    fmtty_of_padding_fmtty pad (String_ty (fmtty_of_fmt rest))
+
+  | Int (_, pad, prec, rest) ->
+    let ty_rest = fmtty_of_fmt rest in
+    let prec_ty = fmtty_of_precision_fmtty prec (Int_ty ty_rest) in
+    fmtty_of_padding_fmtty pad prec_ty
+  | Int32 (_, pad, prec, rest) ->
+    let ty_rest = fmtty_of_fmt rest in
+    let prec_ty = fmtty_of_precision_fmtty prec (Int32_ty ty_rest) in
+    fmtty_of_padding_fmtty pad prec_ty
+  | Nativeint (_, pad, prec, rest) ->
+    let ty_rest = fmtty_of_fmt rest in
+    let prec_ty = fmtty_of_precision_fmtty prec (Nativeint_ty ty_rest) in
+    fmtty_of_padding_fmtty pad prec_ty
+  | Int64 (_, pad, prec, rest) ->
+    let ty_rest = fmtty_of_fmt rest in
+    let prec_ty = fmtty_of_precision_fmtty prec (Int64_ty ty_rest) in
+    fmtty_of_padding_fmtty pad prec_ty
+  | Float (_, pad, prec, rest) ->
+    let ty_rest = fmtty_of_fmt rest in
+    let prec_ty = fmtty_of_precision_fmtty prec (Float_ty ty_rest) in
+    fmtty_of_padding_fmtty pad prec_ty
+
+  | Char rest                  -> Char_ty (fmtty_of_fmt rest)
+  | Caml_char rest             -> Char_ty (fmtty_of_fmt rest)
+  | Bool rest                  -> Bool_ty (fmtty_of_fmt rest)
+  | Alpha rest                 -> Alpha_ty (fmtty_of_fmt rest)
+  | Theta rest                 -> Theta_ty (fmtty_of_fmt rest)
+  | Reader rest                -> Reader_ty (fmtty_of_fmt rest)
+
+  | Format_arg (_, ty, rest) ->
+    Format_arg_ty (ty, fmtty_of_fmt rest)
+  | Format_subst (_, ty, rest) ->
+    Format_subst_ty (ty, ty, fmtty_of_fmt rest)
+
+  | Flush rest                 -> fmtty_of_fmt rest
+  | String_literal (_, rest)   -> fmtty_of_fmt rest
+  | Char_literal (_, rest)     -> fmtty_of_fmt rest
+
+  | Scan_char_set (_, _, rest) -> String_ty (fmtty_of_fmt rest)
+  | Scan_get_counter (_, rest) -> Int_ty (fmtty_of_fmt rest)
+  | Ignored_param (ign, rest)  -> fmtty_of_ignored_format ign rest
+  | Formatting_lit (_, rest)   -> fmtty_of_fmt rest
+  | Formatting_gen (fmting_gen, rest)  ->
+    concat_fmtty (fmtty_of_formatting_gen fmting_gen) (fmtty_of_fmt rest)
+
+  | End_of_format              -> End_of_fmtty
+
+(* Extract the fmtty of an ignored parameter followed by the rest of
+   the format. *)
+and fmtty_of_ignored_format : type x y a b c d e f .
+    (a, b, c, d, y, x) ignored ->
+    (x, b, c, y, e, f) fmt ->
+    (a, b, c, d, e, f) fmtty =
+fun ign fmt -> match ign with
+  | Ignored_char                    -> fmtty_of_fmt fmt
+  | Ignored_caml_char               -> fmtty_of_fmt fmt
+  | Ignored_string _                -> fmtty_of_fmt fmt
+  | Ignored_caml_string _           -> fmtty_of_fmt fmt
+  | Ignored_int (_, _)              -> fmtty_of_fmt fmt
+  | Ignored_int32 (_, _)            -> fmtty_of_fmt fmt
+  | Ignored_nativeint (_, _)        -> fmtty_of_fmt fmt
+  | Ignored_int64 (_, _)            -> fmtty_of_fmt fmt
+  | Ignored_float (_, _)            -> fmtty_of_fmt fmt
+  | Ignored_bool                    -> fmtty_of_fmt fmt
+  | Ignored_format_arg _            -> fmtty_of_fmt fmt
+  | Ignored_format_subst (_, fmtty) -> concat_fmtty fmtty (fmtty_of_fmt fmt)
+  | Ignored_reader                  -> Ignored_reader_ty (fmtty_of_fmt fmt)
+  | Ignored_scan_char_set _         -> fmtty_of_fmt fmt
+  | Ignored_scan_get_counter _      -> fmtty_of_fmt fmt
+
+(* Add an Int_ty node if padding is taken as an extra argument (ex: "%*s"). *)
+and fmtty_of_padding_fmtty : type x a b c d e f .
+    (x, a) padding -> (a, b, c, d, e, f) fmtty -> (x, b, c, d, e, f) fmtty =
+  fun pad fmtty -> match pad with
+    | No_padding    -> fmtty
+    | Lit_padding _ -> fmtty
+    | Arg_padding _ -> Int_ty fmtty
+
+(* Add an Int_ty node if precision is taken as an extra argument (ex: "%.*f").*)
+and fmtty_of_precision_fmtty : type x a b c d e f .
+    (x, a) precision -> (a, b, c, d, e, f) fmtty -> (x, b, c, d, e, f) fmtty =
+  fun prec fmtty -> match prec with
+    | No_precision    -> fmtty
+    | Lit_precision _ -> fmtty
+    | Arg_precision   -> Int_ty fmtty
+
+(******************************************************************************)
+                            (* Format typing *)
+
+(* Exception raised when a format does not match a given format type. *)
+exception Type_mismatch
+
+(* Type a padding. *)
+(* Take an Int_ty from the fmtty if the integer should be kept as argument. *)
+(* Raise Type_mismatch in case of type mismatch. *)
+let type_padding : type a b c d e f x y .
+    (x, y) padding -> (a, b, c, d, e, f) fmtty ->
+      (a, b, c, d, e, f) padding_fmtty_ebb =
+fun pad fmtty -> match pad, fmtty with
+  | No_padding, _ -> Padding_fmtty_EBB (No_padding, fmtty)
+  | Lit_padding (padty, w), _ -> Padding_fmtty_EBB (Lit_padding (padty,w),fmtty)
+  | Arg_padding padty, Int_ty rest -> Padding_fmtty_EBB (Arg_padding padty,rest)
+  | _ -> raise Type_mismatch
+
+(* Convert a (upadding, uprecision) to a (padding, precision). *)
+(* Take one or two Int_ty from the fmtty if needed. *)
+(* Raise Type_mismatch in case of type mismatch. *)
+let type_padprec : type a b c d e f x y z .
+  (x, y) padding -> (y, z) precision -> (a, b, c, d, e, f) fmtty ->
+    (a, b, c, d, e, f) padprec_fmtty_ebb =
+fun pad prec fmtty -> match prec, type_padding pad fmtty with
+  | No_precision, Padding_fmtty_EBB (pad, rest) ->
+    Padprec_fmtty_EBB (pad, No_precision, rest)
+  | Lit_precision p, Padding_fmtty_EBB (pad, rest) ->
+    Padprec_fmtty_EBB (pad, Lit_precision p, rest)
+  | Arg_precision, Padding_fmtty_EBB (pad, Int_ty rest) ->
+    Padprec_fmtty_EBB (pad, Arg_precision, rest)
+  | _, Padding_fmtty_EBB (_, _) -> raise Type_mismatch
+
+(* Type a format according to an fmtty. *)
+(* If typing succeed, generate a copy of the format with the same
+    type parameters as the fmtty. *)
+(* Raise a Failure with an error message in case of type mismatch. *)
+let rec type_format :
+  type a1 b1 c1 d1 e1 f1
+       a2 b2 c2 d2 e2 f2  .
+     (a1, b1, c1, d1, e1, f1) fmt
+  -> (a2, b2, c2, d2, e2, f2) fmtty
+  -> (a2, b2, c2, d2, e2, f2) fmt
+= fun fmt fmtty -> match type_format_gen fmt fmtty with
+  | Fmt_fmtty_EBB (fmt', End_of_fmtty) -> fmt'
+  | _ -> raise Type_mismatch
+
+and type_format_gen :
+  type a1 b1 c1 d1 e1 f1
+       a2 b2 c2 d2 e2 f2  .
+     (a1, b1, c1, d1, e1, f1) fmt
+  -> (a2, b2, c2, d2, e2, f2) fmtty
+  -> (a2, b2, c2, d2, e2, f2) fmt_fmtty_ebb
+= fun fmt fmtty -> match fmt, fmtty with
+  | Char fmt_rest, Char_ty fmtty_rest ->
+    let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt_rest fmtty_rest in
+    Fmt_fmtty_EBB (Char fmt', fmtty')
+  | Caml_char fmt_rest, Char_ty fmtty_rest ->
+    let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt_rest fmtty_rest in
+    Fmt_fmtty_EBB (Caml_char fmt', fmtty')
+  | String (pad, fmt_rest), _ -> (
+    match type_padding pad fmtty with
+    | Padding_fmtty_EBB (pad, String_ty fmtty_rest) ->
+      let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt_rest fmtty_rest in
+      Fmt_fmtty_EBB (String (pad, fmt'), fmtty')
+    | Padding_fmtty_EBB (_, _) -> raise Type_mismatch
+  )
+  | Caml_string (pad, fmt_rest), _ -> (
+    match type_padding pad fmtty with
+    | Padding_fmtty_EBB (pad, String_ty fmtty_rest) ->
+      let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt_rest fmtty_rest in
+      Fmt_fmtty_EBB (Caml_string (pad, fmt'), fmtty')
+    | Padding_fmtty_EBB (_, _) -> raise Type_mismatch
+  )
+  | Int (iconv, pad, prec, fmt_rest), _ -> (
+    match type_padprec pad prec fmtty with
+    | Padprec_fmtty_EBB (pad, prec, Int_ty fmtty_rest) ->
+      let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt_rest fmtty_rest in
+      Fmt_fmtty_EBB (Int (iconv, pad, prec, fmt'), fmtty')
+    | Padprec_fmtty_EBB (_, _, _) -> raise Type_mismatch
+  )
+  | Int32 (iconv, pad, prec, fmt_rest), _ -> (
+    match type_padprec pad prec fmtty with
+    | Padprec_fmtty_EBB (pad, prec, Int32_ty fmtty_rest) ->
+      let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt_rest fmtty_rest in
+      Fmt_fmtty_EBB (Int32 (iconv, pad, prec, fmt'), fmtty')
+    | Padprec_fmtty_EBB (_, _, _) -> raise Type_mismatch
+  )
+  | Nativeint (iconv, pad, prec, fmt_rest), _ -> (
+    match type_padprec pad prec fmtty with
+    | Padprec_fmtty_EBB (pad, prec, Nativeint_ty fmtty_rest) ->
+      let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt_rest fmtty_rest in
+      Fmt_fmtty_EBB (Nativeint (iconv, pad, prec, fmt'), fmtty')
+    | Padprec_fmtty_EBB (_, _, _) -> raise Type_mismatch
+  )
+  | Int64 (iconv, pad, prec, fmt_rest), _ -> (
+    match type_padprec pad prec fmtty with
+    | Padprec_fmtty_EBB (pad, prec, Int64_ty fmtty_rest) ->
+      let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt_rest fmtty_rest in
+      Fmt_fmtty_EBB (Int64 (iconv, pad, prec, fmt'), fmtty')
+    | Padprec_fmtty_EBB (_, _, _) -> raise Type_mismatch
+  )
+  | Float (fconv, pad, prec, fmt_rest), _ -> (
+    match type_padprec pad prec fmtty with
+    | Padprec_fmtty_EBB (pad, prec, Float_ty fmtty_rest) ->
+      let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt_rest fmtty_rest in
+      Fmt_fmtty_EBB (Float (fconv, pad, prec, fmt'), fmtty')
+    | Padprec_fmtty_EBB (_, _, _) -> raise Type_mismatch
+  )
+  | Bool fmt_rest, Bool_ty fmtty_rest ->
+    let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt_rest fmtty_rest in
+    Fmt_fmtty_EBB (Bool fmt', fmtty')
+  | Flush fmt_rest, fmtty_rest ->
+    let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt_rest fmtty_rest in
+    Fmt_fmtty_EBB (Flush fmt', fmtty')
+
+  | String_literal (str, fmt_rest), fmtty_rest ->
+    let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt_rest fmtty_rest in
+    Fmt_fmtty_EBB (String_literal (str, fmt'), fmtty')
+  | Char_literal (chr, fmt_rest), fmtty_rest ->
+    let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt_rest fmtty_rest in
+    Fmt_fmtty_EBB (Char_literal (chr, fmt'), fmtty')
+
+  | Format_arg (pad_opt, sub_fmtty, fmt_rest),
+    Format_arg_ty (sub_fmtty', fmtty_rest) ->
+    if Fmtty_EBB sub_fmtty <> Fmtty_EBB sub_fmtty' then raise Type_mismatch;
+    let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt_rest fmtty_rest in
+    Fmt_fmtty_EBB (Format_arg (pad_opt, sub_fmtty', fmt'), fmtty')
+  | Format_subst (pad_opt, sub_fmtty, fmt_rest),
+    Format_subst_ty (sub_fmtty1, _sub_fmtty2, fmtty_rest) ->
+    if Fmtty_EBB (erase_rel sub_fmtty) <> Fmtty_EBB (erase_rel sub_fmtty1) then
+      raise Type_mismatch;
+    let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt_rest (erase_rel fmtty_rest) in
+    Fmt_fmtty_EBB (Format_subst (pad_opt, sub_fmtty1, fmt'), fmtty')
+  (* Printf and Format specific constructors: *)
+  | Alpha fmt_rest, Alpha_ty fmtty_rest ->
+    let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt_rest fmtty_rest in
+    Fmt_fmtty_EBB (Alpha fmt', fmtty')
+  | Theta fmt_rest, Theta_ty fmtty_rest ->
+    let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt_rest fmtty_rest in
+    Fmt_fmtty_EBB (Theta fmt', fmtty')
+
+  (* Format specific constructors: *)
+  | Formatting_lit (formatting_lit, fmt_rest), fmtty_rest ->
+    let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt_rest fmtty_rest in
+    Fmt_fmtty_EBB (Formatting_lit (formatting_lit, fmt'), fmtty')
+  | Formatting_gen (formatting_gen, fmt_rest), fmtty_rest ->
+    type_formatting_gen formatting_gen fmt_rest fmtty_rest
+
+  (* Scanf specific constructors: *)
+  | Reader fmt_rest, Reader_ty fmtty_rest ->
+    let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt_rest fmtty_rest in
+    Fmt_fmtty_EBB (Reader fmt', fmtty')
+  | Scan_char_set (width_opt, char_set, fmt_rest), String_ty fmtty_rest ->
+    let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt_rest fmtty_rest in
+    Fmt_fmtty_EBB (Scan_char_set (width_opt, char_set, fmt'), fmtty')
+  | Scan_get_counter (counter, fmt_rest), Int_ty fmtty_rest ->
+    let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt_rest fmtty_rest in
+    Fmt_fmtty_EBB (Scan_get_counter (counter, fmt'), fmtty')
+  | Ignored_param (ign, rest), fmtty_rest ->
+    type_ignored_param ign rest fmtty_rest
+
+  | End_of_format, fmtty_rest -> Fmt_fmtty_EBB (End_of_format, fmtty_rest)
+
+  | _ -> raise Type_mismatch
+
+and type_formatting_gen : type a1 a3 b1 b3 c1 c3 d1 d3 e1 e2 e3 f1 f2 f3 .
+    (a1, b1, c1, d1, e1, f1) formatting_gen ->
+    (f1, b1, c1, e1, e2, f2) fmt ->
+    (a3, b3, c3, d3, e3, f3) fmtty ->
+    (a3, b3, c3, d3, e3, f3) fmt_fmtty_ebb =
+fun formatting_gen fmt0 fmtty0 -> match formatting_gen with
+  | Open_tag (Format (fmt1, str)) ->
+    let Fmt_fmtty_EBB (fmt2, fmtty2) = type_format_gen fmt1 fmtty0 in
+    let Fmt_fmtty_EBB (fmt3, fmtty3) = type_format_gen fmt0 fmtty2 in
+    Fmt_fmtty_EBB (Formatting_gen (Open_tag (Format (fmt2, str)), fmt3), fmtty3)
+  | Open_box (Format (fmt1, str)) ->
+    let Fmt_fmtty_EBB (fmt2, fmtty2) = type_format_gen fmt1 fmtty0 in
+    let Fmt_fmtty_EBB (fmt3, fmtty3) = type_format_gen fmt0 fmtty2 in
+    Fmt_fmtty_EBB (Formatting_gen (Open_tag (Format (fmt2, str)), fmt3), fmtty3)
+
+(* Type an Ignored_param node according to an fmtty. *)
+and type_ignored_param : type p q x y z t u v a b c d e f .
+    (x, y, z, t, q, p) ignored ->
+    (p, y, z, q, u, v) fmt ->
+    (a, b, c, d, e, f) fmtty ->
+    (a, b, c, d, e, f) fmt_fmtty_ebb =
+fun ign fmt fmtty -> match ign with
+  | Ignored_char               as ign' -> type_ignored_param_one ign' fmt fmtty
+  | Ignored_caml_char          as ign' -> type_ignored_param_one ign' fmt fmtty
+  | Ignored_string _           as ign' -> type_ignored_param_one ign' fmt fmtty
+  | Ignored_caml_string _      as ign' -> type_ignored_param_one ign' fmt fmtty
+  | Ignored_int _              as ign' -> type_ignored_param_one ign' fmt fmtty
+  | Ignored_int32 _            as ign' -> type_ignored_param_one ign' fmt fmtty
+  | Ignored_nativeint _        as ign' -> type_ignored_param_one ign' fmt fmtty
+  | Ignored_int64 _            as ign' -> type_ignored_param_one ign' fmt fmtty
+  | Ignored_float _            as ign' -> type_ignored_param_one ign' fmt fmtty
+  | Ignored_bool               as ign' -> type_ignored_param_one ign' fmt fmtty
+  | Ignored_scan_char_set _    as ign' -> type_ignored_param_one ign' fmt fmtty
+  | Ignored_scan_get_counter _ as ign' -> type_ignored_param_one ign' fmt fmtty
+  | Ignored_format_arg (pad_opt, sub_fmtty) ->
+    type_ignored_param_one (Ignored_format_arg (pad_opt, sub_fmtty)) fmt fmtty
+  | Ignored_format_subst (pad_opt, sub_fmtty) ->
+    let Fmtty_fmt_EBB (sub_fmtty', Fmt_fmtty_EBB (fmt', fmtty')) =
+      type_ignored_format_substitution sub_fmtty fmt fmtty in
+    Fmt_fmtty_EBB (Ignored_param (Ignored_format_subst (pad_opt, sub_fmtty'), fmt'), fmtty')
+  | Ignored_reader -> (
+    match fmtty with
+    | Ignored_reader_ty fmtty_rest ->
+      let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt fmtty_rest in
+      Fmt_fmtty_EBB (Ignored_param (Ignored_reader, fmt'), fmtty')
+    | _ -> raise Type_mismatch
+  )
+
+and type_ignored_param_one : type a1 a2 b1 b2 c1 c2 d1 d2 e1 e2 f1 f2 .
+    (a2, b2, c2, d2, d2, a2) ignored ->
+    (a1, b1, c1, d1, e1, f1) fmt ->
+    (a2, b2, c2, d2, e2, f2) fmtty ->
+    (a2, b2, c2, d2, e2, f2) fmt_fmtty_ebb
+= fun ign fmt fmtty ->
+  let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt fmtty in
+  Fmt_fmtty_EBB (Ignored_param (ign, fmt'), fmtty')
+
+(* Typing of the complex case: "%_(...%)". *)
+and type_ignored_format_substitution : type w x y z p s t u a b c d e f .
+    (w, x, y, z, s, p) fmtty ->
+    (p, x, y, s, t, u) fmt ->
+    (a, b, c, d, e, f) fmtty -> (a, b, c, d, e, f) fmtty_fmt_ebb =
+fun sub_fmtty fmt fmtty -> match sub_fmtty, fmtty with
+  | Char_ty sub_fmtty_rest, Char_ty fmtty_rest ->
+    let Fmtty_fmt_EBB (sub_fmtty_rest', fmt') =
+      type_ignored_format_substitution sub_fmtty_rest fmt fmtty_rest in
+    Fmtty_fmt_EBB (Char_ty sub_fmtty_rest', fmt')
+  | String_ty sub_fmtty_rest, String_ty fmtty_rest ->
+    let Fmtty_fmt_EBB (sub_fmtty_rest', fmt') =
+      type_ignored_format_substitution sub_fmtty_rest fmt fmtty_rest in
+    Fmtty_fmt_EBB (String_ty sub_fmtty_rest', fmt')
+  | Int_ty sub_fmtty_rest, Int_ty fmtty_rest ->
+    let Fmtty_fmt_EBB (sub_fmtty_rest', fmt') =
+      type_ignored_format_substitution sub_fmtty_rest fmt fmtty_rest in
+    Fmtty_fmt_EBB (Int_ty sub_fmtty_rest', fmt')
+  | Int32_ty sub_fmtty_rest, Int32_ty fmtty_rest ->
+    let Fmtty_fmt_EBB (sub_fmtty_rest', fmt') =
+      type_ignored_format_substitution sub_fmtty_rest fmt fmtty_rest in
+    Fmtty_fmt_EBB (Int32_ty sub_fmtty_rest', fmt')
+  | Nativeint_ty sub_fmtty_rest, Nativeint_ty fmtty_rest ->
+    let Fmtty_fmt_EBB (sub_fmtty_rest', fmt') =
+      type_ignored_format_substitution sub_fmtty_rest fmt fmtty_rest in
+    Fmtty_fmt_EBB (Nativeint_ty sub_fmtty_rest', fmt')
+  | Int64_ty sub_fmtty_rest, Int64_ty fmtty_rest ->
+    let Fmtty_fmt_EBB (sub_fmtty_rest', fmt') =
+      type_ignored_format_substitution sub_fmtty_rest fmt fmtty_rest in
+    Fmtty_fmt_EBB (Int64_ty sub_fmtty_rest', fmt')
+  | Float_ty sub_fmtty_rest, Float_ty fmtty_rest ->
+    let Fmtty_fmt_EBB (sub_fmtty_rest', fmt') =
+      type_ignored_format_substitution sub_fmtty_rest fmt fmtty_rest in
+    Fmtty_fmt_EBB (Float_ty sub_fmtty_rest', fmt')
+  | Bool_ty sub_fmtty_rest, Bool_ty fmtty_rest ->
+    let Fmtty_fmt_EBB (sub_fmtty_rest', fmt') =
+      type_ignored_format_substitution sub_fmtty_rest fmt fmtty_rest in
+    Fmtty_fmt_EBB (Bool_ty sub_fmtty_rest', fmt')
+  | Alpha_ty sub_fmtty_rest, Alpha_ty fmtty_rest ->
+    let Fmtty_fmt_EBB (sub_fmtty_rest', fmt') =
+      type_ignored_format_substitution sub_fmtty_rest fmt fmtty_rest in
+    Fmtty_fmt_EBB (Alpha_ty sub_fmtty_rest', fmt')
+  | Theta_ty sub_fmtty_rest, Theta_ty fmtty_rest ->
+    let Fmtty_fmt_EBB (sub_fmtty_rest', fmt') =
+      type_ignored_format_substitution sub_fmtty_rest fmt fmtty_rest in
+    Fmtty_fmt_EBB (Theta_ty sub_fmtty_rest', fmt')
+  | Reader_ty sub_fmtty_rest, Reader_ty fmtty_rest ->
+    let Fmtty_fmt_EBB (sub_fmtty_rest', fmt') =
+      type_ignored_format_substitution sub_fmtty_rest fmt fmtty_rest in
+    Fmtty_fmt_EBB (Reader_ty sub_fmtty_rest', fmt')
+  | Ignored_reader_ty sub_fmtty_rest, Ignored_reader_ty fmtty_rest ->
+    let Fmtty_fmt_EBB (sub_fmtty_rest', fmt') =
+      type_ignored_format_substitution sub_fmtty_rest fmt fmtty_rest in
+    Fmtty_fmt_EBB (Ignored_reader_ty sub_fmtty_rest', fmt')
+
+  | Format_arg_ty (sub2_fmtty, sub_fmtty_rest),
+    Format_arg_ty (sub2_fmtty', fmtty_rest) ->
+    if Fmtty_EBB sub2_fmtty <> Fmtty_EBB sub2_fmtty' then raise Type_mismatch;
+    let Fmtty_fmt_EBB (sub_fmtty_rest', fmt') =
+      type_ignored_format_substitution sub_fmtty_rest fmt fmtty_rest in
+    Fmtty_fmt_EBB (Format_arg_ty (sub2_fmtty', sub_fmtty_rest'), fmt')
+  | Format_subst_ty (sub1_fmtty,  sub2_fmtty,  sub_fmtty_rest),
+    Format_subst_ty (sub1_fmtty', sub2_fmtty', fmtty_rest) ->
+    (* TODO define Fmtty_rel_EBB to remove those erase_rel *)
+    if Fmtty_EBB (erase_rel sub1_fmtty) <> Fmtty_EBB (erase_rel sub1_fmtty') then raise Type_mismatch;
+    if Fmtty_EBB (erase_rel sub2_fmtty) <> Fmtty_EBB (erase_rel sub2_fmtty') then raise Type_mismatch;
+    let sub_fmtty' = trans (symm sub1_fmtty') sub2_fmtty' in
+    let _, f2, _, f4 = fmtty_rel_det sub_fmtty' in
+    let Refl = f2 Refl in
+    let Refl = f4 Refl in
+    let Fmtty_fmt_EBB (sub_fmtty_rest', fmt') =
+      type_ignored_format_substitution (erase_rel sub_fmtty_rest) fmt fmtty_rest in
+    Fmtty_fmt_EBB (Format_subst_ty (sub1_fmtty', sub2_fmtty', symm sub_fmtty_rest'), fmt')
+  | End_of_fmtty, fmtty ->
+    Fmtty_fmt_EBB (End_of_fmtty, type_format_gen fmt fmtty)
+  | _ -> raise Type_mismatch
+
+(* This implementation of `recast` is a bit disappointing. The
+   invariant provided by the type are very strong: the input format's
+   type is in relation to the output type's as witnessed by the
+   fmtty_rel argument. One would at first expect this function to be
+   total, and implementable by exhaustive pattern matching. Instead,
+   we reuse the highly partial and much less well-defined function
+   `type_format` that has lost all knowledge of the correspondence
+   between the argument's types.
+
+   Besides the fact that this function reuses a lot of the
+   `type_format` logic (eg.: seeing Int_ty in the fmtty parameter does
+   not let you match on Int only, as you may in fact have Float
+   (Arg_padding, ...) ("%.*d") beginning with an Int_ty), it is also
+   a partial function, because the typing information in a format is
+   not quite enough to reconstruct it unambiguously. For example, the
+   format types of "%d%_r" and "%_r%d" have the same format6
+   parameters, but they are not at all exchangeable, and putting one
+   in place of the other must result in a dynamic failure.
+
+   Given that:
+   - we'd have to duplicate a lot of non-trivial typing logic from type_format
+   - this wouldn't even eliminate (all) the dynamic failures
+   we decided to just reuse type_format directly for now.
+*)
+let recast :
+  type a1 b1 c1 d1 e1 f1
+       a2 b2 c2 d2 e2 f2
+  .
+     (a1, b1, c1, d1, e1, f1) fmt
+  -> (a1, b1, c1, d1, e1, f1,
+      a2, b2, c2, d2, e2, f2) fmtty_rel
+  -> (a2, b2, c2, d2, e2, f2) fmt
+= fun fmt fmtty ->
+  type_format fmt (erase_rel (symm fmtty))
+
+(******************************************************************************)
+                             (* Printing tools *)
+
+(* Add padding spaces arround a string. *)
+let fix_padding padty width str =
+  let len = String.length str in
+  if width <= len then str else
+    let res = Bytes.make width (if padty = Zeros then '0' else ' ') in
+    begin match padty with
+    | Left  -> String.blit str 0 res 0 len
+    | Right -> String.blit str 0 res (width - len) len
+    | Zeros when len > 0 && (str.[0] = '+' || str.[0] = '-' || str.[0] = ' ') ->
+      Bytes.set res 0 str.[0];
+      String.blit str 1 res (width - len + 1) (len - 1)
+    | Zeros when len > 1 && str.[0] = '0' && (str.[1] = 'x' || str.[1] = 'X') ->
+      Bytes.set res 1 str.[1];
+      String.blit str 2 res (width - len + 2) (len - 2)
+    | Zeros ->
+      String.blit str 0 res (width - len) len
+    end;
+    Bytes.unsafe_to_string res
+
+(* Add '0' padding to int, int32, nativeint or int64 string representation. *)
+let fix_int_precision prec str =
+  let len = String.length str in
+  if prec <= len then str else
+    let res = Bytes.make prec '0' in
+    begin match str.[0] with
+    | ('+' | '-' | ' ') as c ->
+      Bytes.set res 0 c;
+      String.blit str 1 res (prec - len + 1) (len - 1);
+    | '0' when len > 1 && (str.[1] = 'x' || str.[1] = 'X') ->
+      Bytes.set res 1 str.[1];
+      String.blit str 2 res (prec - len + 2) (len - 2);
+    | '0' .. '9' | 'a' .. 'f' | 'A' .. 'F' ->
+      String.blit str 0 res (prec - len) len;
+    | _ ->
+      assert false
+    end;
+    Bytes.unsafe_to_string res
+
+(* Escape a string according to the OCaml lexing convention. *)
+let string_to_caml_string str =
+  String.concat (String.escaped str) ["\""; "\""]
+
+(* Generate the format_int first argument from an int_conv. *)
+let format_of_iconv iconv = match iconv with
+  | Int_d -> "%d" | Int_pd -> "%+d" | Int_sd -> "% d"
+  | Int_i -> "%i" | Int_pi -> "%+i" | Int_si -> "% i"
+  | Int_x -> "%x" | Int_Cx -> "%#x"
+  | Int_X -> "%X" | Int_CX -> "%#X"
+  | Int_o -> "%o" | Int_Co -> "%#o"
+  | Int_u -> "%u"
+
+(* Generate the format_int32, format_nativeint and format_int64 first
+   argument from an int_conv. *)
+let format_of_aconv iconv c =
+  let seps = match iconv with
+  | Int_d -> ["%";"d"] | Int_pd -> ["%+";"d"] | Int_sd -> ["% ";"d"]
+  | Int_i -> ["%";"i"] | Int_pi -> ["%+";"i"] | Int_si -> ["% ";"i"]
+  | Int_x -> ["%";"x"] | Int_Cx -> ["%#";"x"]
+  | Int_X -> ["%";"X"] | Int_CX -> ["%#";"X"]
+  | Int_o -> ["%";"o"] | Int_Co -> ["%#";"o"]
+  | Int_u -> ["%";"u"]
+  in String.concat (String.make 1 c) seps
+
+(* Generate the format_float first argument form a float_conv. *)
+let format_of_fconv fconv prec =
+  let symb = if fconv = Float_F then 'g' else char_of_fconv fconv in
+  let buf = buffer_create 16 in
+  buffer_add_char buf '%';
+  bprint_fconv_flag buf fconv;
+  buffer_add_char buf '.';
+  buffer_add_string buf (string_of_int prec);
+  buffer_add_char buf symb;
+  buffer_contents buf
+
+(* Convert an integer to a string according to a conversion. *)
+let convert_int iconv n = format_int (format_of_iconv iconv) n
+let convert_int32 iconv n = format_int32 (format_of_aconv iconv 'l') n
+let convert_nativeint iconv n = format_nativeint (format_of_aconv iconv 'n') n
+let convert_int64 iconv n = format_int64 (format_of_aconv iconv 'L') n
+
+(* Convert a float to string. *)
+(* Fix special case of "OCaml float format". *)
+let convert_float fconv prec x =
+  let str = format_float (format_of_fconv fconv prec) x in
+  if fconv <> Float_F then str else
+    let len = String.length str in
+    let rec is_valid i =
+      if i = len then false else
+        match str.[i] with
+        | '.' | 'e' | 'E' -> true
+        | _ -> is_valid (i + 1)
+    in
+    match classify_float x with
+    | FP_normal | FP_subnormal | FP_zero ->
+      if is_valid 0 then str else str ^ "."
+    | FP_infinite ->
+      if x < 0.0 then "neg_infinity" else "infinity"
+    | FP_nan -> "nan"
+
+(* Convert a char to a string according to the OCaml lexical convention. *)
+let format_caml_char c =
+  String.concat (Char.escaped c) ["'"; "'"]
+
+(* Convert a format type to string *)
+let string_of_fmtty fmtty =
+  let buf = buffer_create 16 in
+  bprint_fmtty buf fmtty;
+  buffer_contents buf
+
+(******************************************************************************)
+                        (* Generic printing function *)
+
+(* Make a generic printing function. *)
+(* Used to generate Printf and Format printing functions. *)
+(* Parameters:
+     k: a continuation finally applied to the output stream and the accumulator.
+     o: the output stream (see k, %a and %t).
+     acc: rev list of printing entities (string, char, flush, formatting, ...).
+     fmt: the format. *)
+let rec make_printf : type a b c d e f .
+    (b -> (b, c) acc -> f) -> b -> (b, c) acc ->
+    (a, b, c, d, e, f) fmt -> a =
+fun k o acc fmt -> match fmt with
+  | Char rest ->
+    fun c ->
+      let new_acc = Acc_char (acc, c) in
+      make_printf k o new_acc rest
+  | Caml_char rest ->
+    fun c ->
+      let new_acc = Acc_string (acc, format_caml_char c) in
+      make_printf k o new_acc rest
+  | String (pad, rest) ->
+    make_string_padding k o acc rest pad (fun str -> str)
+  | Caml_string (pad, rest) ->
+    make_string_padding k o acc rest pad string_to_caml_string
+  | Int (iconv, pad, prec, rest) ->
+    make_int_padding_precision k o acc rest pad prec convert_int iconv
+  | Int32 (iconv, pad, prec, rest) ->
+    make_int_padding_precision k o acc rest pad prec convert_int32 iconv
+  | Nativeint (iconv, pad, prec, rest) ->
+    make_int_padding_precision k o acc rest pad prec convert_nativeint iconv
+  | Int64 (iconv, pad, prec, rest) ->
+    make_int_padding_precision k o acc rest pad prec convert_int64 iconv
+  | Float (fconv, pad, prec, rest) ->
+    make_float_padding_precision k o acc rest pad prec fconv
+  | Bool rest ->
+    fun b -> make_printf k o (Acc_string (acc, string_of_bool b)) rest
+  | Alpha rest ->
+    fun f x -> make_printf k o (Acc_delay (acc, fun o -> f o x)) rest
+  | Theta rest ->
+    fun f -> make_printf k o (Acc_delay (acc, f)) rest
+  | Reader _ ->
+    (* This case is impossible, by typing of formats. *)
+    (* Indeed, since printf and co. take a format4 as argument, the 'd and 'e
+       type parameters of fmt are obviously equals. The Reader is the
+       only constructor which touch 'd and 'e type parameters of the format
+       type, it adds an (->) to the 'd parameters. Consequently, a format4
+       cannot contain a Reader node, except in the sub-format associated to
+       an %{...%}. It's not a problem because make_printf do not call
+       itself recursively on the sub-format associated to %{...%}. *)
+    assert false
+  | Flush rest ->
+    make_printf k o (Acc_flush acc) rest
+
+  | String_literal (str, rest) ->
+    make_printf k o (Acc_string (acc, str)) rest
+  | Char_literal (chr, rest) ->
+    make_printf k o (Acc_char (acc, chr)) rest
+
+  | Format_arg (_, sub_fmtty, rest) ->
+    let ty = string_of_fmtty sub_fmtty in
+    (fun str ->
+      ignore str;
+      make_printf k o (Acc_string (acc, ty)) rest)
+  | Format_subst (_, fmtty, rest) ->
+    fun (Format (fmt, _)) -> make_printf k o acc
+      (concat_fmt (recast fmt fmtty) rest)
+
+  | Scan_char_set (_, _, rest) ->
+    let new_acc = Acc_invalid_arg (acc, "Printf: bad conversion %[") in
+    fun _ -> make_printf k o new_acc rest
+  | Scan_get_counter (_, rest) ->
+    (* This case should be refused for Printf. *)
+    (* Accepted for backward compatibility. *)
+    (* Interpret %l, %n and %L as %u. *)
+    fun n ->
+      let new_acc = Acc_string (acc, format_int "%u" n) in
+      make_printf k o new_acc rest
+  | Ignored_param (ign, rest) ->
+    make_ignored_param k o acc ign rest
+
+  | Formatting_lit (fmting_lit, rest) ->
+    make_printf k o (Acc_formatting_lit (acc, fmting_lit)) rest
+  | Formatting_gen (Open_tag (Format (fmt', _)), rest) ->
+    let k' koc kacc =
+      make_printf k koc (Acc_formatting_gen (acc, Acc_open_tag kacc)) rest in
+    make_printf k' o End_of_acc fmt'
+  | Formatting_gen (Open_box (Format (fmt', _)), rest) ->
+    let k' koc kacc =
+      make_printf k koc (Acc_formatting_gen (acc, Acc_open_box kacc)) rest in
+    make_printf k' o End_of_acc fmt'
+
+  | End_of_format ->
+    k o acc
+
+(* Delay the error (Invalid_argument "Printf: bad conversion %_"). *)
+(* Generate functions to take remaining arguments (after the "%_"). *)
+and make_ignored_param : type x y a b c d e f .
+    (b -> (b, c) acc -> f) -> b -> (b, c) acc ->
+    (a, b, c, d, y, x) ignored ->
+    (x, b, c, y, e, f) fmt -> a =
+fun k o acc ign fmt -> match ign with
+  | Ignored_char                    -> make_invalid_arg k o acc fmt
+  | Ignored_caml_char               -> make_invalid_arg k o acc fmt
+  | Ignored_string _                -> make_invalid_arg k o acc fmt
+  | Ignored_caml_string _           -> make_invalid_arg k o acc fmt
+  | Ignored_int (_, _)              -> make_invalid_arg k o acc fmt
+  | Ignored_int32 (_, _)            -> make_invalid_arg k o acc fmt
+  | Ignored_nativeint (_, _)        -> make_invalid_arg k o acc fmt
+  | Ignored_int64 (_, _)            -> make_invalid_arg k o acc fmt
+  | Ignored_float (_, _)            -> make_invalid_arg k o acc fmt
+  | Ignored_bool                    -> make_invalid_arg k o acc fmt
+  | Ignored_format_arg _            -> make_invalid_arg k o acc fmt
+  | Ignored_format_subst (_, fmtty) -> make_from_fmtty k o acc fmtty fmt
+  | Ignored_reader                  -> assert false
+  | Ignored_scan_char_set _         -> make_invalid_arg k o acc fmt
+  | Ignored_scan_get_counter _      -> make_invalid_arg k o acc fmt
+
+
+(* Special case of printf "%_(". *)
+and make_from_fmtty : type x y a b c d e f .
+    (b -> (b, c) acc -> f) -> b -> (b, c) acc ->
+    (a, b, c, d, y, x) fmtty ->
+    (x, b, c, y, e, f) fmt -> a =
+fun k o acc fmtty fmt -> match fmtty with
+  | Char_ty rest            -> fun _ -> make_from_fmtty k o acc rest fmt
+  | String_ty rest          -> fun _ -> make_from_fmtty k o acc rest fmt
+  | Int_ty rest             -> fun _ -> make_from_fmtty k o acc rest fmt
+  | Int32_ty rest           -> fun _ -> make_from_fmtty k o acc rest fmt
+  | Nativeint_ty rest       -> fun _ -> make_from_fmtty k o acc rest fmt
+  | Int64_ty rest           -> fun _ -> make_from_fmtty k o acc rest fmt
+  | Float_ty rest           -> fun _ -> make_from_fmtty k o acc rest fmt
+  | Bool_ty rest            -> fun _ -> make_from_fmtty k o acc rest fmt
+  | Alpha_ty rest           -> fun _ _ -> make_from_fmtty k o acc rest fmt
+  | Theta_ty rest           -> fun _ -> make_from_fmtty k o acc rest fmt
+  | Reader_ty _             -> assert false
+  | Ignored_reader_ty _     -> assert false
+  | Format_arg_ty (_, rest) -> fun _ -> make_from_fmtty k o acc rest fmt
+  | End_of_fmtty            -> make_invalid_arg k o acc fmt
+  | Format_subst_ty (ty1, ty2, rest) ->
+    let ty = trans (symm ty1) ty2 in
+    fun _ -> make_from_fmtty k o acc (concat_fmtty ty rest) fmt
+
+(* Insert an Acc_invalid_arg in the accumulator and continue to generate
+   closures to get the remaining arguments. *)
+and make_invalid_arg : type a b c d e f .
+    (b -> (b, c) acc -> f) -> b -> (b, c) acc ->
+    (a, b, c, d, e, f) fmt -> a =
+fun k o acc fmt ->
+  make_printf k o (Acc_invalid_arg (acc, "Printf: bad conversion %_")) fmt
+
+(* Fix padding, take it as an extra integer argument if needed. *)
+and make_string_padding : type x z a b c d e f .
+    (b -> (b, c) acc -> f) -> b -> (b, c) acc ->
+    (a, b, c, d, e, f) fmt ->
+    (x, z -> a) padding -> (z -> string) -> x =
+  fun k o acc fmt pad trans -> match pad with
+  | No_padding ->
+    fun x ->
+      let new_acc = Acc_string (acc, trans x) in
+      make_printf k o new_acc fmt
+  | Lit_padding (padty, width) ->
+    fun x ->
+      let new_acc = Acc_string (acc, fix_padding padty width (trans x)) in
+      make_printf k o new_acc fmt
+  | Arg_padding padty ->
+    fun w x ->
+      let new_acc = Acc_string (acc, fix_padding padty w (trans x)) in
+      make_printf k o new_acc fmt
+
+(* Fix padding and precision for int, int32, nativeint or int64. *)
+(* Take one or two extra integer arguments if needed. *)
+and make_int_padding_precision : type x y z a b c d e f .
+    (b -> (b, c) acc -> f) -> b -> (b, c) acc ->
+    (a, b, c, d, e, f) fmt ->
+    (x, y) padding -> (y, z -> a) precision -> (int_conv -> z -> string) ->
+    int_conv -> x =
+  fun k o acc fmt pad prec trans iconv -> match pad, prec with
+  | No_padding, No_precision ->
+    fun x ->
+      let str = trans iconv x in
+      make_printf k o (Acc_string (acc, str)) fmt
+  | No_padding, Lit_precision p ->
+    fun x ->
+      let str = fix_int_precision p (trans iconv x) in
+      make_printf k o (Acc_string (acc, str)) fmt
+  | No_padding, Arg_precision ->
+    fun p x ->
+      let str = fix_int_precision p (trans iconv x) in
+      make_printf k o (Acc_string (acc, str)) fmt
+  | Lit_padding (padty, w), No_precision ->
+    fun x ->
+      let str = fix_padding padty w (trans iconv x) in
+      make_printf k o (Acc_string (acc, str)) fmt
+  | Lit_padding (padty, w), Lit_precision p ->
+    fun x ->
+      let str = fix_padding padty w (fix_int_precision p (trans iconv x)) in
+      make_printf k o (Acc_string (acc, str)) fmt
+  | Lit_padding (padty, w), Arg_precision ->
+    fun p x ->
+      let str = fix_padding padty w (fix_int_precision p (trans iconv x)) in
+      make_printf k o (Acc_string (acc, str)) fmt
+  | Arg_padding padty, No_precision ->
+    fun w x ->
+      let str = fix_padding padty w (trans iconv x) in
+      make_printf k o (Acc_string (acc, str)) fmt
+  | Arg_padding padty, Lit_precision p ->
+    fun w x ->
+      let str = fix_padding padty w (fix_int_precision p (trans iconv x)) in
+      make_printf k o (Acc_string (acc, str)) fmt
+  | Arg_padding padty, Arg_precision ->
+    fun w p x ->
+      let str = fix_padding padty w (fix_int_precision p (trans iconv x)) in
+      make_printf k o (Acc_string (acc, str)) fmt
+
+(* Convert a float, fix padding and precision if needed. *)
+(* Take the float argument and one or two extra integer arguments if needed. *)
+and make_float_padding_precision : type x y a b c d e f .
+    (b -> (b, c) acc -> f) -> b -> (b, c) acc ->
+    (a, b, c, d, e, f) fmt ->
+    (x, y) padding -> (y, float -> a) precision -> float_conv -> x =
+  fun k o acc fmt pad prec fconv -> match pad, prec with
+  | No_padding, No_precision ->
+    fun x ->
+      let str = convert_float fconv default_float_precision x in
+      make_printf k o (Acc_string (acc, str)) fmt
+  | No_padding, Lit_precision p ->
+    fun x ->
+      let str = convert_float fconv p x in
+      make_printf k o (Acc_string (acc, str)) fmt
+  | No_padding, Arg_precision ->
+    fun p x ->
+      let str = convert_float fconv p x in
+      make_printf k o (Acc_string (acc, str)) fmt
+  | Lit_padding (padty, w), No_precision ->
+    fun x ->
+      let str = convert_float fconv default_float_precision x in
+      let str' = fix_padding padty w str in
+      make_printf k o (Acc_string (acc, str')) fmt
+  | Lit_padding (padty, w), Lit_precision p ->
+    fun x ->
+      let str = fix_padding padty w (convert_float fconv p x) in
+      make_printf k o (Acc_string (acc, str)) fmt
+  | Lit_padding (padty, w), Arg_precision ->
+    fun p x ->
+      let str = fix_padding padty w (convert_float fconv p x) in
+      make_printf k o (Acc_string (acc, str)) fmt
+  | Arg_padding padty, No_precision ->
+    fun w x ->
+      let str = convert_float fconv default_float_precision x in
+      let str' = fix_padding padty w str in
+      make_printf k o (Acc_string (acc, str')) fmt
+  | Arg_padding padty, Lit_precision p ->
+    fun w x ->
+      let str = fix_padding padty w (convert_float fconv p x) in
+      make_printf k o (Acc_string (acc, str)) fmt
+  | Arg_padding padty, Arg_precision ->
+    fun w p x ->
+      let str = fix_padding padty w (convert_float fconv p x) in
+      make_printf k o (Acc_string (acc, str)) fmt
+
+(******************************************************************************)
+                          (* Continuations for make_printf *)
+
+(* Recursively output an "accumulator" containing a reversed list of
+   printing entities (string, char, flus, ...) in an output_stream. *)
+(* Used as a continuation of make_printf. *)
+let rec output_acc o acc = match acc with
+  | Acc_formatting_lit (p, fmting_lit) ->
+    let s = string_of_formatting_lit fmting_lit in
+    output_acc o p; output_string o s;
+  | Acc_formatting_gen (p, Acc_open_tag acc') ->
+    output_acc o p; output_string o "@{"; output_acc o acc';
+  | Acc_formatting_gen (p, Acc_open_box acc') ->
+    output_acc o p; output_string o "@["; output_acc o acc';
+  | Acc_string (p, s)        -> output_acc o p; output_string o s
+  | Acc_char (p, c)          -> output_acc o p; output_char o c
+  | Acc_delay (p, f)         -> output_acc o p; f o
+  | Acc_flush p              -> output_acc o p; flush o
+  | Acc_invalid_arg (p, msg) -> output_acc o p; invalid_arg msg;
+  | End_of_acc               -> ()
+
+(* Recursively output an "accumulator" containing a reversed list of
+   printing entities (string, char, flus, ...) in a buffer. *)
+(* Used as a continuation of make_printf. *)
+let rec bufput_acc b acc = match acc with
+  | Acc_formatting_lit (p, fmting_lit) ->
+    let s = string_of_formatting_lit fmting_lit in
+    bufput_acc b p; Buffer.add_string b s;
+  | Acc_formatting_gen (p, Acc_open_tag acc') ->
+    bufput_acc b p; Buffer.add_string b "@{"; bufput_acc b acc';
+  | Acc_formatting_gen (p, Acc_open_box acc') ->
+    bufput_acc b p; Buffer.add_string b "@["; bufput_acc b acc';
+  | Acc_string (p, s)        -> bufput_acc b p; Buffer.add_string b s
+  | Acc_char (p, c)          -> bufput_acc b p; Buffer.add_char b c
+  | Acc_delay (p, f)         -> bufput_acc b p; f b
+  | Acc_flush p              -> bufput_acc b p;
+  | Acc_invalid_arg (p, msg) -> bufput_acc b p; invalid_arg msg;
+  | End_of_acc               -> ()
+
+(* Recursively output an "accumulator" containing a reversed list of
+   printing entities (string, char, flus, ...) in a buffer. *)
+(* Differ from bufput_acc by the interpretation of %a and %t. *)
+(* Used as a continuation of make_printf. *)
+let rec strput_acc b acc = match acc with
+  | Acc_formatting_lit (p, fmting_lit) ->
+    let s = string_of_formatting_lit fmting_lit in
+    strput_acc b p; Buffer.add_string b s;
+  | Acc_formatting_gen (p, Acc_open_tag acc') ->
+    strput_acc b p; Buffer.add_string b "@{"; strput_acc b acc';
+  | Acc_formatting_gen (p, Acc_open_box acc') ->
+    strput_acc b p; Buffer.add_string b "@["; strput_acc b acc';
+  | Acc_string (p, s)        -> strput_acc b p; Buffer.add_string b s
+  | Acc_char (p, c)          -> strput_acc b p; Buffer.add_char b c
+  | Acc_delay (p, f)         -> strput_acc b p; Buffer.add_string b (f ())
+  | Acc_flush p              -> strput_acc b p;
+  | Acc_invalid_arg (p, msg) -> strput_acc b p; invalid_arg msg;
+  | End_of_acc               -> ()
+
+(******************************************************************************)
+                          (* Error managment *)
+
+(* Raise a Failure with a pretty-printed error message. *)
+let failwith_message (Format (fmt, _)) =
+  let buf = Buffer.create 256 in
+  let k () acc = strput_acc buf acc; failwith (Buffer.contents buf) in
+  make_printf k () End_of_acc fmt
+
+(******************************************************************************)
+                            (* Formatting tools *)
+
+(* Convert a string to an open block description (indent, block_type) *)
+let open_box_of_string str =
+  if str = "" then (0, Pp_box) else
+    let len = String.length str in
+    let invalid_box () = failwith_message "invalid box description %S" str in
+    let rec parse_spaces i =
+      if i = len then i else
+        match str.[i] with
+        | ' ' | '\t' -> parse_spaces (i + 1)
+        | _ -> i
+    and parse_lword i j =
+      if j = len then j else
+        match str.[j] with
+        | 'a' .. 'z' -> parse_lword i (j + 1)
+        | _ -> j
+    and parse_int i j =
+      if j = len then j else
+        match str.[j] with
+        | '0' .. '9' | '-' -> parse_int i (j + 1)
+        | _ -> j in
+    let wstart = parse_spaces 0 in
+    let wend = parse_lword wstart wstart in
+    let box_name = String.sub str wstart (wend - wstart) in
+    let nstart = parse_spaces wend in
+    let nend = parse_int nstart nstart in
+    let indent =
+      if nstart = nend then 0 else
+        try int_of_string (String.sub str nstart (nend - nstart))
+        with Failure _ -> invalid_box () in
+    let exp_end = parse_spaces nend in
+    let () = if exp_end <> len then invalid_box () in
+    let box_type = match box_name with
+      | "" | "b" -> Pp_box
+      | "h"      -> Pp_hbox
+      | "v"      -> Pp_vbox
+      | "hv"     -> Pp_hvbox
+      | "hov"    -> Pp_hovbox
+      | _        -> invalid_box () in
+    (indent, box_type)
+
+(******************************************************************************)
+                            (* Parsing tools *)
+
+(* Create a padding_fmt_ebb from a padding and a format. *)
+(* Copy the padding to disjoin the type parameters of argument and result. *)
+let make_padding_fmt_ebb : type x y .
+    (x, y) padding -> (_, _, _, _, _, _) fmt ->
+      (_, _, _, _, _) padding_fmt_ebb =
+fun pad fmt -> match pad with
+  | No_padding         -> Padding_fmt_EBB (No_padding, fmt)
+  | Lit_padding (s, w) -> Padding_fmt_EBB (Lit_padding (s, w), fmt)
+  | Arg_padding s      -> Padding_fmt_EBB (Arg_padding s, fmt)
+
+(* Create a precision_fmt_ebb from a precision and a format. *)
+(* Copy the precision to disjoin the type parameters of argument and result. *)
+let make_precision_fmt_ebb : type x y .
+    (x, y) precision -> (_, _, _, _, _, _) fmt ->
+      (_, _, _, _, _) precision_fmt_ebb =
+fun prec fmt -> match prec with
+  | No_precision    -> Precision_fmt_EBB (No_precision, fmt)
+  | Lit_precision p -> Precision_fmt_EBB (Lit_precision p, fmt)
+  | Arg_precision   -> Precision_fmt_EBB (Arg_precision, fmt)
+
+(* Create a padprec_fmt_ebb forma a padding, a precision and a format. *)
+(* Copy the padding and the precision to disjoin type parameters of arguments
+   and result. *)
+let make_padprec_fmt_ebb : type x y z t .
+    (x, y) padding -> (z, t) precision ->
+    (_, _, _, _, _, _) fmt ->
+    (_, _, _, _, _) padprec_fmt_ebb =
+fun pad prec fmt ->
+  let Precision_fmt_EBB (prec, fmt') = make_precision_fmt_ebb prec fmt in
+  match pad with
+  | No_padding         -> Padprec_fmt_EBB (No_padding, prec, fmt')
+  | Lit_padding (s, w) -> Padprec_fmt_EBB (Lit_padding (s, w), prec, fmt')
+  | Arg_padding s      -> Padprec_fmt_EBB (Arg_padding s, prec, fmt')
+
+(******************************************************************************)
+                             (* Format parsing *)
+
+(* Parse a string representing a format and create a fmt_ebb. *)
+(* Raise an Failure exception in case of invalid format. *)
+let fmt_ebb_of_string str =
+  (* Parameters naming convention:                                    *)
+  (*   - lit_start: start of the literal sequence.                    *)
+  (*   - str_ind: current index in the string.                        *)
+  (*   - end_ind: end of the current (sub-)format.                    *)
+  (*   - pct_ind: index of the '%' in the current micro-format.       *)
+  (*   - zero:  is the '0' flag defined in the current micro-format.  *)
+  (*   - minus: is the '-' flag defined in the current micro-format.  *)
+  (*   - plus:  is the '+' flag defined in the current micro-format.  *)
+  (*   - sharp: is the '#' flag defined in the current micro-format.  *)
+  (*   - space: is the ' ' flag defined in the current micro-format.  *)
+  (*   - ign:   is the '_' flag defined in the current micro-format.  *)
+  (*   - pad: padding of the current micro-format.                    *)
+  (*   - prec: precision of the current micro-format.                 *)
+  (*   - symb: char representing the conversion ('c', 's', 'd', ...). *)
+  (*   - char_set: set of characters as bitmap (see scanf %[...]).    *)
+
+  (* Raise a Failure with a friendly error message. *)
+  (* Used when the end of the format (or the current sub-format) was encoutered
+      unexpectedly. *)
+  let unexpected_end_of_format end_ind =
+    failwith_message
+      "invalid format %S: at character number %d, unexpected end of format"
+      str end_ind;
+
+  (* Raise Failure with a friendly error message about an option dependencie
+     problem. *)
+  and invalid_format_without str_ind c s =
+    failwith_message
+      "invalid format %S: at character number %d, '%c' without %s"
+      str str_ind c s
+
+  (* Raise Failure with a friendly error message about an unexpected
+     character. *)
+  and expected_character str_ind expected read =
+    failwith_message
+     "invalid format %S: at character number %d, %s expected, read %C"
+      str str_ind expected read in
+
+  (* Parse the string from beg_ind (included) to end_ind (excluded). *)
+  let rec parse : type e f . int -> int -> (_, _, e, f) fmt_ebb =
+  fun beg_ind end_ind -> parse_literal beg_ind beg_ind end_ind
+
+  (* Read literal characters up to '%' or '@' special characters. *)
+  and parse_literal : type e f . int -> int -> int -> (_, _, e, f) fmt_ebb =
+  fun lit_start str_ind end_ind ->
+    if str_ind = end_ind then add_literal lit_start str_ind End_of_format else
+      match str.[str_ind] with
+      | '%' ->
+        let Fmt_EBB fmt_rest = parse_format str_ind end_ind in
+        add_literal lit_start str_ind fmt_rest
+      | '@' ->
+        let Fmt_EBB fmt_rest = parse_after_at (str_ind + 1) end_ind in
+        add_literal lit_start str_ind fmt_rest
+      | _ ->
+        parse_literal lit_start (str_ind + 1) end_ind
+
+  (* Parse a format after '%' *)
+  and parse_format : type e f . int -> int -> (_, _, e, f) fmt_ebb =
+  fun pct_ind end_ind -> parse_ign pct_ind (pct_ind + 1) end_ind
+
+  and parse_ign : type e f . int -> int -> int -> (_, _, e, f) fmt_ebb =
+  fun pct_ind str_ind end_ind ->
+    match str.[str_ind] with
+      | '_' -> parse_flags pct_ind (str_ind+1) end_ind true
+      | _ -> parse_flags pct_ind str_ind end_ind false
+
+  and parse_flags : type e f . int -> int -> int -> bool -> (_, _, e, f) fmt_ebb =
+  fun pct_ind str_ind end_ind ign ->
+    let zero = ref false and minus = ref false
+    and plus = ref false and space = ref false
+    and sharp = ref false in
+    let set_flag str_ind flag =
+      (* in legacy mode, duplicate flags are accepted *)
+      if !flag && not legacy_behavior then
+        failwith_message
+          "invalid format %S: at character number %d, duplicate flag %C"
+          str str_ind str.[str_ind];
+      flag := true;
+    in
+    let rec read_flags str_ind =
+      if str_ind = end_ind then unexpected_end_of_format end_ind;
+      begin match str.[str_ind] with
+      | '0' -> set_flag str_ind zero;  read_flags (str_ind + 1)
+      | '-' -> set_flag str_ind minus; read_flags (str_ind + 1)
+      | '+' -> set_flag str_ind plus;  read_flags (str_ind + 1)
+      | '#' -> set_flag str_ind sharp; read_flags (str_ind + 1)
+      | ' ' -> set_flag str_ind space; read_flags (str_ind + 1)
+      | _ ->
+        parse_padding pct_ind str_ind end_ind
+          !zero !minus !plus !sharp !space ign
+      end
+    in
+    read_flags str_ind
+
+  (* Try to read a digital or a '*' padding. *)
+  and parse_padding : type e f .
+      int -> int -> int -> bool -> bool -> bool -> bool -> bool -> bool ->
+        (_, _, e, f) fmt_ebb =
+  fun pct_ind str_ind end_ind zero minus plus sharp space ign ->
+    if str_ind = end_ind then unexpected_end_of_format end_ind;
+    let padty = match zero, minus with
+      | false, false -> Right
+      | false, true  -> Left
+      |  true, false -> Zeros
+      |  true, true  ->
+        if legacy_behavior then Left
+        else incompatible_flag pct_ind str_ind '-' "0" in
+    match str.[str_ind] with
+    | '0' .. '9' ->
+      let new_ind, width = parse_positive str_ind end_ind 0 in
+      parse_after_padding pct_ind new_ind end_ind plus sharp space ign
+        (Lit_padding (padty, width))
+    | '*' ->
+      parse_after_padding pct_ind (str_ind + 1) end_ind plus sharp space ign
+        (Arg_padding padty)
+    | _ ->
+      if legacy_behavior then
+        parse_after_padding pct_ind str_ind end_ind plus sharp space ign
+          No_padding
+      else begin match padty with
+      | Left  ->
+        invalid_format_without (str_ind - 1) '-' "padding"
+      | Zeros ->
+        invalid_format_without (str_ind - 1) '0' "padding"
+      | Right ->
+        parse_after_padding pct_ind str_ind end_ind plus sharp space ign
+          No_padding
+      end
+
+  (* Is precision defined? *)
+  and parse_after_padding : type x e f .
+      int -> int -> int -> bool -> bool -> bool -> bool -> (x, _) padding ->
+        (_, _, e, f) fmt_ebb =
+  fun pct_ind str_ind end_ind plus sharp space ign pad ->
+    if str_ind = end_ind then unexpected_end_of_format end_ind;
+    match str.[str_ind] with
+    | '.' ->
+      parse_precision pct_ind (str_ind + 1) end_ind plus sharp space ign pad
+    | symb ->
+      parse_conversion pct_ind (str_ind + 1) end_ind plus sharp space ign pad
+        No_precision symb
+
+  (* Read the digital or '*' precision. *)
+  and parse_precision : type x e f .
+      int -> int -> int -> bool -> bool -> bool -> bool -> (x, _) padding ->
+        (_, _, e, f) fmt_ebb =
+  fun pct_ind str_ind end_ind plus sharp space ign pad ->
+    if str_ind = end_ind then unexpected_end_of_format end_ind;
+    let parse_literal str_ind =
+      let new_ind, prec = parse_positive str_ind end_ind 0 in
+      parse_conversion pct_ind (new_ind + 1) end_ind plus sharp space ign pad
+        (Lit_precision prec) str.[new_ind] in
+    match str.[str_ind] with
+    | '0' .. '9' -> parse_literal str_ind
+    | ('+' | '-') when legacy_behavior ->
+      (* Legacy mode would accept and ignore '+' or '-' before the
+         integer describing the desired precision; not that this
+         cannot happen for padding width, as '+' and '-' already have
+         a semantics there.
+
+         That said, the idea (supported by this tweak) that width and
+         precision literals are "integer literals" in the OCaml sense is
+         still blatantly wrong, as 123_456 or 0xFF are rejected. *)
+      parse_literal (str_ind + 1)
+    | '*' ->
+      parse_after_precision pct_ind (str_ind + 1) end_ind plus sharp space ign
+        pad Arg_precision
+    | _ ->
+      if legacy_behavior then
+        (* note that legacy implementation did not ignore '.' without
+           a number (as it does for padding indications), but
+           interprets it as '.0' *)
+        parse_after_precision pct_ind str_ind end_ind plus sharp space ign pad (Lit_precision 0) else
+      invalid_format_without (str_ind - 1) '.' "precision"
+
+  (* Try to read the conversion. *)
+  and parse_after_precision : type x z e f .
+      int -> int -> int -> bool -> bool -> bool -> bool -> (x, _) padding ->
+        (z, _) precision -> (_, _, e, f) fmt_ebb =
+  fun pct_ind str_ind end_ind plus sharp space ign pad prec ->
+    if str_ind = end_ind then unexpected_end_of_format end_ind;
+    parse_conversion pct_ind (str_ind + 1) end_ind plus sharp space ign pad prec
+      str.[str_ind]
+
+  (* Case analysis on conversion. *)
+  and parse_conversion : type x y z t e f .
+      int -> int -> int -> bool -> bool -> bool -> bool -> (x, y) padding ->
+        (z, t) precision -> char -> (_, _, e, f) fmt_ebb =
+  fun pct_ind str_ind end_ind plus sharp space ign pad prec symb ->
+    (* Flags used to check option usages/compatibilities. *)
+    let plus_used  = ref false and sharp_used = ref false
+    and space_used = ref false and ign_used   = ref false
+    and pad_used   = ref false and prec_used  = ref false in
+
+    (* Access to options, update flags. *)
+    let get_plus  () = plus_used  := true; plus
+    and get_sharp () = sharp_used := true; sharp
+    and get_space () = space_used := true; space
+    and get_ign   () = ign_used   := true; ign
+    and get_pad   () = pad_used   := true; pad
+    and get_prec  () = prec_used  := true; prec in
+
+    (* Check that padty <> Zeros. *)
+    let check_no_0 symb (type a) (type b) (pad : (a,b) padding) =
+      match pad with
+      | No_padding -> pad
+      | Lit_padding ((Left | Right), _) -> pad
+      | Arg_padding (Left | Right) -> pad
+      | Lit_padding (Zeros, width) ->
+        if legacy_behavior then Lit_padding (Right, width)
+        else incompatible_flag pct_ind str_ind symb "0"
+      | Arg_padding Zeros ->
+        if legacy_behavior then Arg_padding Right
+        else incompatible_flag pct_ind str_ind symb "0"
+    in
+
+    (* Get padding as a pad_option (see "%_", "%{", "%(" and "%[").
+       (no need for legacy mode tweaking, those were rejected by the
+       legacy parser as well) *)
+    let get_pad_opt c = match get_pad () with
+      | No_padding -> None
+      | Lit_padding (Right, width) -> Some width
+      | Lit_padding (Zeros, width) ->
+        if legacy_behavior then Some width
+        else incompatible_flag pct_ind str_ind c "'0'"
+      | Lit_padding (Left, width) ->
+        if legacy_behavior then Some width
+        else incompatible_flag pct_ind str_ind c "'-'"
+      | Arg_padding _          -> incompatible_flag pct_ind str_ind c "'*'"
+    in
+
+    (* Get precision as a prec_option (see "%_f").
+       (no need for legacy mode tweaking, those were rejected by the
+       legacy parser as well) *)
+    let get_prec_opt () = match get_prec () with
+      | No_precision       -> None
+      | Lit_precision ndec -> Some ndec
+      | Arg_precision      -> incompatible_flag pct_ind str_ind '_' "'*'"
+    in
+
+    let fmt_result = match symb with
+    | ',' ->
+      parse str_ind end_ind
+    | 'c' ->
+      let Fmt_EBB fmt_rest = parse str_ind end_ind in
+      if get_ign () then Fmt_EBB (Ignored_param (Ignored_char, fmt_rest))
+      else Fmt_EBB (Char fmt_rest)
+    | 'C' ->
+      let Fmt_EBB fmt_rest = parse str_ind end_ind in
+      if get_ign () then Fmt_EBB (Ignored_param (Ignored_caml_char,fmt_rest))
+      else Fmt_EBB (Caml_char fmt_rest)
+    | 's' ->
+      let pad = check_no_0 symb (get_pad ()) in
+      let Fmt_EBB fmt_rest = parse str_ind end_ind in
+      if get_ign () then
+        let ignored = Ignored_string (get_pad_opt '_') in
+        Fmt_EBB (Ignored_param (ignored, fmt_rest))
+      else
+        let Padding_fmt_EBB (pad', fmt_rest') =
+          make_padding_fmt_ebb pad fmt_rest in
+        Fmt_EBB (String (pad', fmt_rest'))
+    | 'S' ->
+      let pad = check_no_0 symb (get_pad ()) in
+      let Fmt_EBB fmt_rest = parse str_ind end_ind in
+      if get_ign () then
+        let ignored = Ignored_caml_string (get_pad_opt '_') in
+        Fmt_EBB (Ignored_param (ignored, fmt_rest))
+      else
+        let Padding_fmt_EBB (pad', fmt_rest') =
+          make_padding_fmt_ebb pad fmt_rest in
+        Fmt_EBB (Caml_string (pad', fmt_rest'))
+    | 'd' | 'i' | 'x' | 'X' | 'o' | 'u' ->
+      let iconv = compute_int_conv pct_ind str_ind (get_plus ()) (get_sharp ())
+        (get_space ()) symb in
+      let Fmt_EBB fmt_rest = parse str_ind end_ind in
+      if get_ign () then
+        let ignored = Ignored_int (iconv, get_pad_opt '_') in
+        Fmt_EBB (Ignored_param (ignored, fmt_rest))
+      else
+        let Padprec_fmt_EBB (pad', prec', fmt_rest') =
+          make_padprec_fmt_ebb (get_pad ()) (get_prec ()) fmt_rest in
+        Fmt_EBB (Int (iconv, pad', prec', fmt_rest'))
+    | 'N' ->
+      let Fmt_EBB fmt_rest = parse str_ind end_ind in
+      let counter = Token_counter in
+      if get_ign () then
+        let ignored = Ignored_scan_get_counter counter in
+        Fmt_EBB (Ignored_param (ignored, fmt_rest))
+      else
+      Fmt_EBB (Scan_get_counter (counter, fmt_rest))
+    | 'l' | 'n' | 'L' when str_ind=end_ind || not (is_int_base str.[str_ind]) ->
+      let Fmt_EBB fmt_rest = parse str_ind end_ind in
+      let counter = counter_of_char symb in
+      if get_ign () then
+        let ignored = Ignored_scan_get_counter counter in
+        Fmt_EBB (Ignored_param (ignored, fmt_rest))
+      else
+        Fmt_EBB (Scan_get_counter (counter, fmt_rest))
+    | 'l' ->
+      let iconv =
+        compute_int_conv pct_ind (str_ind + 1) (get_plus ()) (get_sharp ())
+          (get_space ()) str.[str_ind] in
+      let Fmt_EBB fmt_rest = parse (str_ind + 1) end_ind in
+      if get_ign () then
+        let ignored = Ignored_int32 (iconv, get_pad_opt '_') in
+        Fmt_EBB (Ignored_param (ignored, fmt_rest))
+      else
+        let Padprec_fmt_EBB (pad', prec', fmt_rest') =
+          make_padprec_fmt_ebb (get_pad ()) (get_prec ()) fmt_rest in
+        Fmt_EBB (Int32 (iconv, pad', prec', fmt_rest'))
+    | 'n' ->
+      let iconv =
+        compute_int_conv pct_ind (str_ind + 1) (get_plus ())
+          (get_sharp ()) (get_space ()) str.[str_ind] in
+      let Fmt_EBB fmt_rest = parse (str_ind + 1) end_ind in
+      if get_ign () then
+        let ignored = Ignored_nativeint (iconv, get_pad_opt '_') in
+        Fmt_EBB (Ignored_param (ignored, fmt_rest))
+      else
+        let Padprec_fmt_EBB (pad', prec', fmt_rest') =
+          make_padprec_fmt_ebb (get_pad ()) (get_prec ()) fmt_rest in
+        Fmt_EBB (Nativeint (iconv, pad', prec', fmt_rest'))
+    | 'L' ->
+      let iconv =
+        compute_int_conv pct_ind (str_ind + 1) (get_plus ()) (get_sharp ())
+          (get_space ()) str.[str_ind] in
+      let Fmt_EBB fmt_rest = parse (str_ind + 1) end_ind in
+      if get_ign () then
+        let ignored = Ignored_int64 (iconv, get_pad_opt '_') in
+        Fmt_EBB (Ignored_param (ignored, fmt_rest))
+      else
+        let Padprec_fmt_EBB (pad', prec', fmt_rest') =
+          make_padprec_fmt_ebb (get_pad ()) (get_prec ()) fmt_rest in
+        Fmt_EBB (Int64 (iconv, pad', prec', fmt_rest'))
+    | 'f' | 'e' | 'E' | 'g' | 'G' | 'F' ->
+      let fconv = compute_float_conv pct_ind str_ind (get_plus ())
+        (get_space ()) symb in
+      let Fmt_EBB fmt_rest = parse str_ind end_ind in
+      if get_ign () then
+        let ignored = Ignored_float (get_pad_opt '_', get_prec_opt ()) in
+        Fmt_EBB (Ignored_param (ignored, fmt_rest))
+      else
+        let Padprec_fmt_EBB (pad', prec', fmt_rest') =
+          make_padprec_fmt_ebb (get_pad ()) (get_prec ()) fmt_rest in
+        Fmt_EBB (Float (fconv, pad', prec', fmt_rest'))
+    | 'b' | 'B' ->
+      let Fmt_EBB fmt_rest = parse str_ind end_ind in
+      if get_ign () then Fmt_EBB (Ignored_param (Ignored_bool, fmt_rest))
+      else Fmt_EBB (Bool fmt_rest)
+    | 'a' ->
+      let Fmt_EBB fmt_rest = parse str_ind end_ind in
+      Fmt_EBB (Alpha fmt_rest)
+    | 't' ->
+      let Fmt_EBB fmt_rest = parse str_ind end_ind in
+      Fmt_EBB (Theta fmt_rest)
+    | 'r' ->
+      let Fmt_EBB fmt_rest = parse str_ind end_ind in
+      if get_ign () then Fmt_EBB (Ignored_param (Ignored_reader, fmt_rest))
+      else Fmt_EBB (Reader fmt_rest)
+    | '!' ->
+      let Fmt_EBB fmt_rest = parse str_ind end_ind in
+      Fmt_EBB (Flush fmt_rest)
+    | ('%' | '@') as c ->
+      let Fmt_EBB fmt_rest = parse str_ind end_ind in
+      Fmt_EBB (Char_literal (c, fmt_rest))
+    | '{' ->
+      let sub_end = search_subformat_end str_ind end_ind '}' in
+      let Fmt_EBB sub_fmt = parse str_ind sub_end in
+      let Fmt_EBB fmt_rest = parse (sub_end + 2) end_ind in
+      let sub_fmtty = fmtty_of_fmt sub_fmt in
+      if get_ign () then
+        let ignored = Ignored_format_arg (get_pad_opt '_', sub_fmtty) in
+        Fmt_EBB (Ignored_param (ignored, fmt_rest))
+      else
+        Fmt_EBB (Format_arg (get_pad_opt '{', sub_fmtty, fmt_rest))
+    | '(' ->
+      let sub_end = search_subformat_end str_ind end_ind ')' in
+      let Fmt_EBB fmt_rest = parse (sub_end + 2) end_ind in
+      let Fmt_EBB sub_fmt = parse str_ind sub_end in
+      let sub_fmtty = fmtty_of_fmt sub_fmt in
+      if get_ign () then
+        let ignored = Ignored_format_subst (get_pad_opt '_', sub_fmtty) in
+        Fmt_EBB (Ignored_param (ignored, fmt_rest))
+      else
+        Fmt_EBB (Format_subst (get_pad_opt '(', sub_fmtty, fmt_rest))
+    | '[' ->
+      let next_ind, char_set = parse_char_set str_ind end_ind in
+      let Fmt_EBB fmt_rest = parse next_ind end_ind in
+      if get_ign () then
+        let ignored = Ignored_scan_char_set (get_pad_opt '_', char_set) in
+        Fmt_EBB (Ignored_param (ignored, fmt_rest))
+      else
+        Fmt_EBB (Scan_char_set (get_pad_opt '[', char_set, fmt_rest))
+    | '-' | '+' | '#' | ' ' | '_' ->
+      failwith_message
+        "invalid format %S: at character number %d, \
+         flag %C is only allowed after the '%%', before padding and precision"
+        str pct_ind symb
+    | _ ->
+      failwith_message
+        "invalid format %S: at character number %d, \
+         invalid conversion \"%%%c\"" str (str_ind - 1) symb
+    in
+    (* Check for unused options, and reject them as incompatible.
+
+       Such checks need to be disabled in legacy mode, as the legacy
+       parser silently ignored incompatible flags. *)
+    if not legacy_behavior then begin
+    if not !plus_used && plus then
+      incompatible_flag pct_ind str_ind symb "'+'";
+    if not !sharp_used && sharp then
+      incompatible_flag pct_ind str_ind symb "'#'";
+    if not !space_used && space then
+      incompatible_flag pct_ind str_ind symb "' '";
+    if not !pad_used  && Padding_EBB pad <> Padding_EBB No_padding then
+      incompatible_flag pct_ind str_ind symb "`padding'";
+    if not !prec_used && Precision_EBB prec <> Precision_EBB No_precision then
+      incompatible_flag pct_ind str_ind (if ign then '_' else symb)
+        "`precision'";
+    if ign && plus then incompatible_flag pct_ind str_ind '_' "'+'";
+    end;
+    (* this last test must not be disabled in legacy mode,
+       as ignoring it would typically result in a different typing
+       than what the legacy parser used *)
+    if not !ign_used && ign then
+      begin match symb with
+        (* argument-less formats can safely be ignored in legacy mode *)
+        | ('@' | '%' | '!' | ',') when legacy_behavior -> ()
+        | _ ->
+          incompatible_flag pct_ind str_ind symb "'_'"
+      end;
+    fmt_result
+
+  (* Parse formatting informations (after '@'). *)
+  and parse_after_at : type e f . int -> int -> (_, _, e, f) fmt_ebb =
+  fun str_ind end_ind ->
+    if str_ind = end_ind then Fmt_EBB (Char_literal ('@', End_of_format))
+    else
+      match str.[str_ind] with
+      | '[' ->
+        parse_tag false (str_ind + 1) end_ind
+      | ']' ->
+        let Fmt_EBB fmt_rest = parse (str_ind + 1) end_ind in
+        Fmt_EBB (Formatting_lit (Close_box, fmt_rest))
+      | '{' ->
+        parse_tag true (str_ind + 1) end_ind
+      | '}' ->
+        let Fmt_EBB fmt_rest = parse (str_ind + 1) end_ind in
+        Fmt_EBB (Formatting_lit (Close_tag, fmt_rest))
+      | ',' ->
+        let Fmt_EBB fmt_rest = parse (str_ind + 1) end_ind in
+        Fmt_EBB (Formatting_lit (Break ("@,", 0, 0), fmt_rest))
+      | ' ' ->
+        let Fmt_EBB fmt_rest = parse (str_ind + 1) end_ind in
+        Fmt_EBB (Formatting_lit (Break ("@ ", 1, 0), fmt_rest))
+      | ';' ->
+        parse_good_break (str_ind + 1) end_ind
+      | '?' ->
+        let Fmt_EBB fmt_rest = parse (str_ind + 1) end_ind in
+        Fmt_EBB (Formatting_lit (FFlush, fmt_rest))
+      | '\n' ->
+        let Fmt_EBB fmt_rest = parse (str_ind + 1) end_ind in
+        Fmt_EBB (Formatting_lit (Force_newline, fmt_rest))
+      | '.' ->
+        let Fmt_EBB fmt_rest = parse (str_ind + 1) end_ind in
+        Fmt_EBB (Formatting_lit (Flush_newline, fmt_rest))
+      | '<' ->
+        parse_magic_size (str_ind + 1) end_ind
+      | '@' ->
+        let Fmt_EBB fmt_rest = parse (str_ind + 1) end_ind in
+        Fmt_EBB (Formatting_lit (Escaped_at, fmt_rest))
+      | '%' when str_ind + 1 < end_ind && str.[str_ind + 1] = '%' ->
+        let Fmt_EBB fmt_rest = parse (str_ind + 2) end_ind in
+        Fmt_EBB (Formatting_lit (Escaped_percent, fmt_rest))
+      | '%' ->
+        let Fmt_EBB fmt_rest = parse str_ind end_ind in
+        Fmt_EBB (Char_literal ('@', fmt_rest))
+      | c ->
+        let Fmt_EBB fmt_rest = parse (str_ind + 1) end_ind in
+        Fmt_EBB (Formatting_lit (Scan_indic c, fmt_rest))
+
+  and check_open_box : type a b c d e f . (a, b, c, d, e, f) fmt -> unit =
+  fun fmt -> match fmt with
+    | String_literal (str, End_of_format) -> (
+      try ignore (open_box_of_string str) with Failure _ ->
+        ((* Emit warning: invalid open box *))
+    )
+    | _ -> ()
+
+  (* Try to read the optionnal <name> after "@{" or "@[". *)
+  and parse_tag : type e f . bool -> int -> int -> (_, _, e, f) fmt_ebb =
+  fun is_open_tag str_ind end_ind ->
+    try
+      if str_ind = end_ind then raise Not_found;
+      match str.[str_ind] with
+      | '<' ->
+        let ind = String.index_from str (str_ind + 1) '>' in
+        if ind >= end_ind then raise Not_found;
+        let sub_str = String.sub str str_ind (ind - str_ind + 1) in
+        let Fmt_EBB fmt_rest = parse (ind + 1) end_ind in
+        let Fmt_EBB sub_fmt = parse str_ind (ind + 1) in
+        let sub_format = Format (sub_fmt, sub_str) in
+        let formatting = if is_open_tag then Open_tag sub_format else (
+          check_open_box sub_fmt;
+          Open_box sub_format) in
+        Fmt_EBB (Formatting_gen (formatting, fmt_rest))
+      | _ ->
+        raise Not_found
+    with Not_found ->
+      let Fmt_EBB fmt_rest = parse str_ind end_ind in
+      let sub_format = Format (End_of_format, "") in
+      let formatting =
+        if is_open_tag then Open_tag sub_format else Open_box sub_format in
+      Fmt_EBB (Formatting_gen (formatting, fmt_rest))
+
+  (* Try to read the optionnal <width offset> after "@;". *)
+  and parse_good_break : type e f . int -> int -> (_, _, e, f) fmt_ebb =
+  fun str_ind end_ind ->
+    let next_ind, formatting_lit =
+      try
+        if str_ind = end_ind || str.[str_ind] <> '<' then raise Not_found; 
+        let str_ind_1 = parse_spaces (str_ind + 1) end_ind in
+        match str.[str_ind_1] with
+        | '0' .. '9' | '-' -> (
+          let str_ind_2, width = parse_integer str_ind_1 end_ind in
+            let str_ind_3 = parse_spaces str_ind_2 end_ind in
+            match str.[str_ind_3] with
+              | '>' ->
+                let s = String.sub str (str_ind-2) (str_ind_3-str_ind+3) in
+                str_ind_3 + 1, Break (s, width, 0)
+              | '0' .. '9' | '-' ->
+                let str_ind_4, offset = parse_integer str_ind_3 end_ind in
+                let str_ind_5 = parse_spaces str_ind_4 end_ind in
+                if str.[str_ind_5] <> '>' then raise Not_found;
+                let s = String.sub str (str_ind-2) (str_ind_5-str_ind+3) in
+                str_ind_5 + 1, Break (s, width, offset)
+              | _ -> raise Not_found
+        )
+        | _ -> raise Not_found
+      with Not_found | Failure _ ->
+        str_ind, Break ("@;", 1, 0)
+    in
+    let Fmt_EBB fmt_rest = parse next_ind end_ind in
+    Fmt_EBB (Formatting_lit (formatting_lit, fmt_rest))
+
+  (* Parse the size in a <n>. *)
+  and parse_magic_size : type e f . int -> int -> (_, _, e, f) fmt_ebb =
+  fun str_ind end_ind ->
+    match
+      try
+        let str_ind_1 = parse_spaces str_ind end_ind in
+        match str.[str_ind_1] with
+        | '0' .. '9' | '-' ->
+          let str_ind_2, size = parse_integer str_ind_1 end_ind in
+          let str_ind_3 = parse_spaces str_ind_2 end_ind in
+          if str.[str_ind_3] <> '>' then raise Not_found;
+          let s = String.sub str (str_ind - 2) (str_ind_3 - str_ind + 3) in
+          Some (str_ind_3 + 1, Magic_size (s, size))
+        | _ -> None
+      with Not_found | Failure _ ->
+        None
+    with
+    | Some (next_ind, formatting_lit) ->
+      let Fmt_EBB fmt_rest = parse next_ind end_ind in
+      Fmt_EBB (Formatting_lit (formatting_lit, fmt_rest))
+    | None ->
+      let Fmt_EBB fmt_rest = parse str_ind end_ind in
+      Fmt_EBB (Formatting_lit (Scan_indic '<', fmt_rest))
+
+  (* Parse and construct a char set. *)
+  and parse_char_set str_ind end_ind =
+    if str_ind = end_ind then unexpected_end_of_format end_ind;
+
+    let char_set = create_char_set () in
+    let add_char c =
+      add_in_char_set char_set c;
+    in
+    let add_range c c' =
+      for i = int_of_char c to int_of_char c' do
+        add_in_char_set char_set (char_of_int i);
+      done;
+    in
+
+    let fail_single_percent str_ind =
+      failwith_message
+        "invalid format %S: '%%' alone is not accepted in character sets, \
+         use %%%% instead at position %d." str str_ind;
+    in
+
+    (* Parse the first character of a char set. *)
+    let rec parse_char_set_start str_ind end_ind =
+      if str_ind = end_ind then unexpected_end_of_format end_ind;
+      let c = str.[str_ind] in
+      parse_char_set_after_char (str_ind + 1) end_ind c;
+
+    (* Parse the content of a char set until the first ']'. *)
+    and parse_char_set_content str_ind end_ind =
+      if str_ind = end_ind then unexpected_end_of_format end_ind;
+      match str.[str_ind] with
+      | ']' ->
+        str_ind + 1
+      | '-' ->
+        add_char '-';
+        parse_char_set_content (str_ind + 1) end_ind;
+      | c ->
+        parse_char_set_after_char (str_ind + 1) end_ind c;
+
+    (* Test for range in char set. *)
+    and parse_char_set_after_char str_ind end_ind c =
+      if str_ind = end_ind then unexpected_end_of_format end_ind;
+      match str.[str_ind] with
+      | ']' ->
+        add_char c;
+        str_ind + 1
+      | '-' ->
+        parse_char_set_after_minus (str_ind + 1) end_ind c
+      | ('%' | '@') as c' when c = '%' ->
+        add_char c';
+        parse_char_set_content (str_ind + 1) end_ind
+      | c' ->
+        if c = '%' then fail_single_percent str_ind;
+        (* note that '@' alone is accepted, as done by the legacy implementation;
+           the documentation specifically requires %@ so we could warn on that *)
+        add_char c;
+        parse_char_set_after_char (str_ind + 1) end_ind c'
+
+    (* Manage range in char set (except if the '-' the last char before ']') *)
+    and parse_char_set_after_minus str_ind end_ind c =
+      if str_ind = end_ind then unexpected_end_of_format end_ind;
+      match str.[str_ind] with
+      | ']' ->
+        add_char c;
+        add_char '-';
+        str_ind + 1
+      | '%' ->
+        if str_ind + 1 = end_ind then unexpected_end_of_format end_ind;
+        begin match str.[str_ind + 1] with
+          | ('%' | '@') as c' ->
+            add_range c c';
+            parse_char_set_content (str_ind + 2) end_ind
+          | _ -> fail_single_percent str_ind
+        end
+      | c' ->
+        add_range c c';
+        parse_char_set_content (str_ind + 1) end_ind
+    in
+    let str_ind, reverse =
+      match str.[str_ind] with
+        | '^' -> str_ind + 1, true
+        | _ -> str_ind, false in
+    let next_ind = parse_char_set_start str_ind end_ind in
+    let char_set = freeze_char_set char_set in
+    next_ind, (if reverse then rev_char_set char_set else char_set)
+
+  (* Consume all next spaces, raise an Failure if end_ind is reached. *)
+  and parse_spaces str_ind end_ind =
+    if str_ind = end_ind then unexpected_end_of_format end_ind;
+    if str.[str_ind] = ' ' then parse_spaces (str_ind + 1) end_ind else str_ind
+
+  (* Read a positive integer from the string, raise a Failure if end_ind is
+     reached. *)
+  and parse_positive str_ind end_ind acc =
+    if str_ind = end_ind then unexpected_end_of_format end_ind;
+    match str.[str_ind] with
+    | '0' .. '9' as c ->
+      let new_acc = acc * 10 + (int_of_char c - int_of_char '0') in
+      if new_acc > Sys.max_string_length then
+        failwith_message
+          "invalid format %S: integer %d is greater than the limit %d"
+          str new_acc Sys.max_string_length
+      else
+        parse_positive (str_ind + 1) end_ind new_acc
+    | _ -> str_ind, acc
+
+  (* Read a positive or negative integer from the string, raise a Failure
+     if end_ind is reached. *)
+  and parse_integer str_ind end_ind =
+    if str_ind = end_ind then unexpected_end_of_format end_ind;
+    match str.[str_ind] with
+    | '0' .. '9' -> parse_positive str_ind end_ind 0
+    | '-' -> (
+      if str_ind + 1 = end_ind then unexpected_end_of_format end_ind;
+      match str.[str_ind + 1] with
+      | '0' .. '9' ->
+        let next_ind, n = parse_positive (str_ind + 1) end_ind 0 in
+        next_ind, -n
+      | c ->
+        expected_character (str_ind + 1) "digit" c
+    )
+    | _ -> assert false
+
+  (* Add a literal to a format from a literal character sub-sequence. *)
+  and add_literal : type a d e f .
+      int -> int -> (a, _, _, d, e, f) fmt ->
+      (_, _, e, f) fmt_ebb =
+  fun lit_start str_ind fmt -> match str_ind - lit_start with
+    | 0    -> Fmt_EBB fmt
+    | 1    -> Fmt_EBB (Char_literal (str.[lit_start], fmt))
+    | size -> Fmt_EBB (String_literal (String.sub str lit_start size, fmt))
+
+  (* Search the end of the current sub-format
+     (i.e. the corresponding "%}" or "%)") *)
+  and search_subformat_end str_ind end_ind c =
+    if str_ind = end_ind then
+      failwith_message
+        "invalid format %S: unclosed sub-format, \
+         expected \"%%%c\" at character number %d" str c end_ind;
+    match str.[str_ind] with
+    | '%' ->
+      if str_ind + 1 = end_ind then unexpected_end_of_format end_ind;
+      if str.[str_ind + 1] = c then (* End of format found *) str_ind else
+        begin match str.[str_ind + 1] with
+        | '_' ->
+          (* Search for "%_(" or "%_{". *)
+          if str_ind + 2 = end_ind then unexpected_end_of_format end_ind;
+          begin match str.[str_ind + 2] with
+          | '{' ->
+            let sub_end = search_subformat_end (str_ind + 3) end_ind '}' in
+            search_subformat_end (sub_end + 2) end_ind c
+          | '(' ->
+            let sub_end = search_subformat_end (str_ind + 3) end_ind ')' in
+            search_subformat_end (sub_end + 2) end_ind c
+          | _ -> search_subformat_end (str_ind + 3) end_ind c
+          end
+        | '{' ->
+          (* %{...%} sub-format found. *)
+          let sub_end = search_subformat_end (str_ind + 2) end_ind '}' in
+          search_subformat_end (sub_end + 2) end_ind c
+        | '(' ->
+          (* %(...%) sub-format found. *)
+          let sub_end = search_subformat_end (str_ind + 2) end_ind ')' in
+          search_subformat_end (sub_end + 2) end_ind c
+        | '}' ->
+          (* Error: %(...%}. *)
+          expected_character (str_ind + 1) "character ')'" '}';
+        | ')' ->
+          (* Error: %{...%). *)
+          expected_character (str_ind + 1) "character '}'" ')';
+        | _ ->
+          search_subformat_end (str_ind + 2) end_ind c
+        end
+    | _ -> search_subformat_end (str_ind + 1) end_ind c
+
+  (* Check if symb is a valid int conversion after "%l", "%n" or "%L" *)
+  and is_int_base symb = match symb with
+    | 'd' | 'i' | 'x' | 'X' | 'o' | 'u' -> true
+    | _ -> false
+
+  (* Convert a char (l, n or L) to its associated counter. *)
+  and counter_of_char symb = match symb with
+    | 'l' -> Line_counter  | 'n' -> Char_counter
+    | 'L' -> Token_counter | _ -> assert false
+
+  (* Convert (plus, symb) to its associated int_conv. *)
+  and compute_int_conv pct_ind str_ind plus sharp space symb =
+    match plus, sharp, space, symb with
+    | false, false, false, 'd' -> Int_d  | false, false, false, 'i' -> Int_i
+    | false, false,  true, 'd' -> Int_sd | false, false,  true, 'i' -> Int_si
+    |  true, false, false, 'd' -> Int_pd |  true, false, false, 'i' -> Int_pi
+    | false, false, false, 'x' -> Int_x  | false, false, false, 'X' -> Int_X
+    | false,  true, false, 'x' -> Int_Cx | false,  true, false, 'X' -> Int_CX
+    | false, false, false, 'o' -> Int_o
+    | false,  true, false, 'o' -> Int_Co
+    | false, false, false, 'u' -> Int_u
+    | _, true, _, 'x' when legacy_behavior -> Int_Cx
+    | _, true, _, 'X' when legacy_behavior -> Int_CX
+    | _, true, _, 'o' when legacy_behavior -> Int_Co
+    | _, true, _, _ ->
+      if legacy_behavior then (* ignore *)
+        compute_int_conv pct_ind str_ind plus false space symb
+      else incompatible_flag pct_ind str_ind symb "'#'"
+    | true, false, true, _ ->
+      if legacy_behavior then
+        (* plus and space: legacy implementation prefers plus *)
+        compute_int_conv pct_ind str_ind plus sharp false symb
+      else incompatible_flag pct_ind str_ind ' ' "'+'"
+    | false, false, true, _    ->
+      if legacy_behavior then (* ignore *)
+        compute_int_conv pct_ind str_ind plus sharp false symb
+      else incompatible_flag pct_ind str_ind symb "' '"
+    | true, false, false, _    ->
+      if legacy_behavior then (* ignore *)
+        compute_int_conv pct_ind str_ind false sharp space symb
+      else incompatible_flag pct_ind str_ind symb "'+'"
+    | false, false, false, _ -> assert false
+
+  (* Convert (plus, symb) to its associated float_conv. *)
+  and compute_float_conv pct_ind str_ind plus space symb =
+  match plus, space, symb with
+    | false, false, 'f' -> Float_f  | false, false, 'e' -> Float_e
+    | false,  true, 'f' -> Float_sf | false,  true, 'e' -> Float_se
+    |  true, false, 'f' -> Float_pf |  true, false, 'e' -> Float_pe
+    | false, false, 'E' -> Float_E  | false, false, 'g' -> Float_g
+    | false,  true, 'E' -> Float_sE | false,  true, 'g' -> Float_sg
+    |  true, false, 'E' -> Float_pE |  true, false, 'g' -> Float_pg
+    | false, false, 'G' -> Float_G
+    | false,  true, 'G' -> Float_sG
+    |  true, false, 'G' -> Float_pG
+    | false, false, 'F' -> Float_F
+    |  true,  true, _ ->
+      if legacy_behavior then
+        (* plus and space: legacy implementation prefers plus *)
+        compute_float_conv pct_ind str_ind plus false symb
+      else incompatible_flag pct_ind str_ind ' ' "'+'"
+    | false,  true, _ ->
+      if legacy_behavior then (* ignore *)
+        compute_float_conv pct_ind str_ind plus false symb
+      else incompatible_flag pct_ind str_ind symb "' '"
+    |  true, false, _ ->
+      if legacy_behavior then (* ignore *)
+        compute_float_conv pct_ind str_ind false space symb
+      else incompatible_flag pct_ind str_ind symb "'+'"
+    | false, false, _ -> assert false
+
+  (* Raise a Failure with a friendly error message about incompatible options.*)
+  and incompatible_flag : type a . int -> int -> char -> string -> a =
+    fun pct_ind str_ind symb option ->
+      let subfmt = String.sub str pct_ind (str_ind - pct_ind) in
+      failwith_message
+        "invalid format %S: at character number %d, \
+         %s is incompatible with '%c' in sub-format %S"
+        str pct_ind option symb subfmt;
+
+  in parse 0 (String.length str)
+
+(******************************************************************************)
+                  (* Guarded string to format conversions *)
+
+(* Convert a string to a format according to an fmtty. *)
+(* Raise a Failure with an error message in case of type mismatch. *)
+let format_of_string_fmtty str fmtty =
+  let Fmt_EBB fmt = fmt_ebb_of_string str in
+  try Format (type_format fmt fmtty, str)
+  with Type_mismatch ->
+    failwith_message
+      "bad input: format type mismatch between %S and %S"
+      str (string_of_fmtty fmtty)
+
+(* Convert a string to a format compatible with an other format. *)
+(* Raise a Failure with an error message in case of type mismatch. *)
+let format_of_string_format str (Format (fmt', str')) =
+  let Fmt_EBB fmt = fmt_ebb_of_string str in
+  try Format (type_format fmt (fmtty_of_fmt fmt'), str)
+  with Type_mismatch ->
+    failwith_message
+      "bad input: format type mismatch between %S and %S" str str'
diff --git a/stdlib/camlinternalFormat.mli b/stdlib/camlinternalFormat.mli
new file mode 100644
index 0000000000..728dc865ac
--- /dev/null
+++ b/stdlib/camlinternalFormat.mli
@@ -0,0 +1,98 @@
+(* No comments, OCaml stdlib internal use only. *)
+
+open CamlinternalFormatBasics
+
+val is_in_char_set : char_set -> char -> bool
+val rev_char_set : char_set -> char_set
+
+type mutable_char_set = bytes
+val create_char_set : unit -> mutable_char_set
+val add_in_char_set : mutable_char_set -> char -> unit
+val freeze_char_set : mutable_char_set -> char_set
+
+type ('a, 'b, 'c, 'd, 'e, 'f) param_format_ebb = Param_format_EBB :
+     ('x -> 'a, 'b, 'c, 'd, 'e, 'f) fmt ->
+     ('a, 'b, 'c, 'd, 'e, 'f) param_format_ebb
+
+val param_format_of_ignored_format :
+  ('a, 'b, 'c, 'd, 'y, 'x) ignored -> ('x, 'b, 'c, 'y, 'e, 'f) fmt ->
+  ('a, 'b, 'c, 'd, 'e, 'f) param_format_ebb
+
+type ('b, 'c) acc_formatting_gen =
+  | Acc_open_tag of ('b, 'c) acc
+  | Acc_open_box of ('b, 'c) acc
+
+and ('b, 'c) acc =
+  | Acc_formatting_lit of ('b, 'c) acc * formatting_lit
+  | Acc_formatting_gen of ('b, 'c) acc * ('b, 'c) acc_formatting_gen
+  | Acc_string         of ('b, 'c) acc * string
+  | Acc_char           of ('b, 'c) acc * char
+  | Acc_delay          of ('b, 'c) acc * ('b -> 'c)
+  | Acc_flush          of ('b, 'c) acc
+  | Acc_invalid_arg    of ('b, 'c) acc * string
+  | End_of_acc
+
+type ('a, 'b) heter_list =
+  | Cons : 'c * ('a, 'b) heter_list -> ('c -> 'a, 'b) heter_list
+  | Nil : ('b, 'b) heter_list
+
+type ('b, 'c, 'e, 'f) fmt_ebb = Fmt_EBB :
+     ('a, 'b, 'c, 'd, 'e, 'f) CamlinternalFormatBasics.fmt ->
+     ('b, 'c, 'e, 'f) fmt_ebb
+
+val make_printf :
+  ('b -> ('b, 'c) acc -> 'd) -> 'b -> ('b, 'c) acc ->
+  ('a, 'b, 'c, 'c, 'c, 'd) CamlinternalFormatBasics.fmt -> 'a
+
+val output_acc : out_channel -> (out_channel, unit) acc -> unit
+val bufput_acc : Buffer.t -> (Buffer.t, unit) acc -> unit
+val strput_acc : Buffer.t -> (unit, string) acc -> unit
+
+val type_format :
+  ('x, 'b, 'c, 't, 'u, 'v) CamlinternalFormatBasics.fmt ->
+  ('a, 'b, 'c, 'd, 'e, 'f) CamlinternalFormatBasics.fmtty ->
+  ('a, 'b, 'c, 'd, 'e, 'f) CamlinternalFormatBasics.fmt
+
+val fmt_ebb_of_string : string -> ('b, 'c, 'e, 'f) fmt_ebb
+
+val format_of_string_fmtty :
+  string ->
+  ('a, 'b, 'c, 'd, 'e, 'f) CamlinternalFormatBasics.fmtty ->
+  ('a, 'b, 'c, 'd, 'e, 'f) CamlinternalFormatBasics.format6
+
+val format_of_string_format :
+  string ->
+  ('a, 'b, 'c, 'd, 'e, 'f) CamlinternalFormatBasics.format6 ->
+  ('a, 'b, 'c, 'd, 'e, 'f) CamlinternalFormatBasics.format6
+
+val char_of_iconv : CamlinternalFormatBasics.int_conv -> char
+val string_of_formatting_lit : CamlinternalFormatBasics.formatting_lit -> string
+val string_of_formatting_gen :
+  ('a, 'b, 'c, 'd, 'e, 'f) CamlinternalFormatBasics.formatting_gen -> string
+
+val string_of_fmtty :
+  ('a, 'b, 'c, 'd, 'e, 'f) CamlinternalFormatBasics.fmtty -> string
+val string_of_fmt :
+  ('a, 'b, 'c, 'd, 'e, 'f) CamlinternalFormatBasics.fmt -> string
+
+val open_box_of_string : string -> int * block_type
+
+val symm :
+   ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+    'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+-> ('a2, 'b2, 'c2, 'd2, 'e2, 'f2,
+    'a1, 'b1, 'c1, 'd1, 'e1, 'f1) fmtty_rel
+
+val trans :
+   ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+    'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+-> ('a2, 'b2, 'c2, 'd2, 'e2, 'f2,
+    'a3, 'b3, 'c3, 'd3, 'e3, 'f3) fmtty_rel
+-> ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+    'a3, 'b3, 'c3, 'd3, 'e3, 'f3) fmtty_rel
+
+val recast :
+   ('a1, 'b1, 'c1, 'd1, 'e1, 'f1) fmt
+-> ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+    'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+-> ('a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmt
diff --git a/stdlib/camlinternalFormatBasics.ml b/stdlib/camlinternalFormatBasics.ml
new file mode 100644
index 0000000000..e51e4e2ce8
--- /dev/null
+++ b/stdlib/camlinternalFormatBasics.ml
@@ -0,0 +1,614 @@
+(* Padding position. *)
+type padty =
+  | Left   (* Text is left justified ('-' option).               *)
+  | Right  (* Text is right justified (no '-' option).           *)
+  | Zeros  (* Text is right justified by zeros (see '0' option). *)
+
+(***)
+
+(* Integer conversion. *)
+type int_conv =
+  | Int_d | Int_pd | Int_sd        (*  %d | %+d | % d  *)
+  | Int_i | Int_pi | Int_si        (*  %i | %+i | % i  *)
+  | Int_x | Int_Cx                 (*  %x | %#x        *)
+  | Int_X | Int_CX                 (*  %X | %#X        *)
+  | Int_o | Int_Co                 (*  %o | %#o        *)
+  | Int_u                          (*  %u              *)
+
+(* Float conversion. *)
+type float_conv =
+  | Float_f | Float_pf | Float_sf  (*  %f | %+f | % f  *)
+  | Float_e | Float_pe | Float_se  (*  %e | %+e | % e  *)
+  | Float_E | Float_pE | Float_sE  (*  %E | %+E | % E  *)
+  | Float_g | Float_pg | Float_sg  (*  %g | %+g | % g  *)
+  | Float_G | Float_pG | Float_sG  (*  %G | %+G | % G  *)
+  | Float_F                        (*  %F              *)
+
+(***)
+
+(* Char sets (see %[...]) are bitmaps implemented as 32-char strings. *)
+type char_set = string
+
+(***)
+
+(* Counter used in Scanf. *)
+type counter =
+  | Line_counter     (*  %l      *)
+  | Char_counter     (*  %n      *)
+  | Token_counter    (*  %N, %L  *)
+
+(***)
+
+(* Padding of strings and numbers. *)
+type ('a, 'b) padding =
+  (* No padding (ex: "%d") *)
+  | No_padding  : ('a, 'a) padding
+  (* Literal padding (ex: "%8d") *)
+  | Lit_padding : padty * int -> ('a, 'a) padding
+  (* Padding as extra argument (ex: "%*d") *)
+  | Arg_padding : padty -> (int -> 'a, 'a) padding
+
+(* Some formats, such as %_d,
+   only accept an optional number as padding option (no extra argument) *)
+type pad_option = int option
+
+(* Precision of floats and '0'-padding of integers. *)
+type ('a, 'b) precision =
+  (* No precision (ex: "%f") *)
+  | No_precision : ('a, 'a) precision
+  (* Literal precision (ex: "%.3f") *)
+  | Lit_precision : int -> ('a, 'a) precision
+  (* Precision as extra argument (ex: "%.*f") *)
+  | Arg_precision : (int -> 'a, 'a) precision
+
+(* Some formats, such as %_f,
+   only accept an optional number as precision option (no extra argument) *)
+type prec_option = int option
+
+(***)
+
+(*        Relational format types
+
+In the first format+gadts implementation, the type for %(..%) in the
+fmt GADT was as follows:
+
+| Format_subst :                                           (* %(...%) *)
+    pad_option * ('d1, 'q1, 'd2, 'q2) reader_nb_unifier *
+    ('x, 'b, 'c, 'd1, 'q1, 'u) fmtty *
+    ('u, 'b, 'c, 'q1, 'e1, 'f) fmt ->
+      (('x, 'b, 'c, 'd2, 'q2, 'u) format6 -> 'x, 'b, 'c, 'd1, 'e1, 'f) fmt
+
+Notice that the 'u parameter in 'f position in the format argument
+(('x, .., 'u) format6 -> ..) is equal to the 'u parameter in 'a
+position in the format tail (('u, .., 'f) fmt). This means that the
+type of the expected format parameter depends of where the %(...%)
+are in the format string:
+
+  # Printf.printf "%(%)";;
+  - : (unit, out_channel, unit, '_a, '_a, unit)
+      CamlinternalFormatBasics.format6 -> unit
+  = <fun>
+  # Printf.printf "%(%)%d";;
+  - : (int -> unit, out_channel, unit, '_a, '_a, int -> unit)
+      CamlinternalFormatBasics.format6 -> int -> unit
+  = <fun>
+
+On the contrary, the legacy typer gives a clever type that does not
+depend on the position of %(..%) in the format string. For example,
+%(%) will have the polymorphic type ('a, 'b, 'c, 'd, 'd, 'a): it can
+be concatenated to any format type, and only enforces the constraint
+that its 'a and 'f parameters are equal (no format arguments) and 'd
+and 'e are equal (no reader argument).
+
+The weakening of this parameter type in the GADT version broke user
+code (in fact it essentially made %(...%) unusable except at the last
+position of a format). In particular, the following would not work
+anymore:
+
+  fun sep ->
+    Format.printf "foo%(%)bar%(%)baz" sep sep
+
+As the type-checker would require two *incompatible* types for the %(%)
+in different positions.
+
+The solution to regain a general type for %(..%) is to generalize this
+technique, not only on the 'd, 'e parameters, but on all six
+parameters of a format: we introduce a "relational" type
+  ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+   'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+whose values are proofs that ('a1, .., 'f1) and ('a2, .., 'f2) morally
+correspond to the same format type: 'a1 is obtained from 'f1,'b1,'c1
+in the exact same way that 'a2 is obtained from 'f2,'b2,'c2, etc.
+
+For example, the relation between two format types beginning with a Char
+parameter is as follows:
+
+| Char_ty :                                                 (* %c  *)
+    ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+    (char -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     char -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+
+In the general case, the term structure of fmtty_rel is (almost¹)
+isomorphic to the fmtty of the previous implementation: every
+constructor is re-read with a binary, relational type, instead of the
+previous unary typing. fmtty can then be re-defined as the diagonal of
+fmtty_rel:
+
+  type ('a, 'b, 'c, 'd, 'e, 'f) fmtty =
+       ('a, 'b, 'c, 'd, 'e, 'f,
+        'a, 'b, 'c, 'd, 'e, 'f) fmtty_rel
+
+Once we have this fmtty_rel type in place, we can give the more
+general type to %(...%):
+
+| Format_subst :                                           (* %(...%) *)
+    pad_option *
+    ('g, 'h, 'i, 'j, 'k, 'l,
+     'g2, 'b, 'c, 'j2, 'd, 'a) fmtty_rel *
+    ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+    (('g, 'h, 'i, 'j, 'k, 'l) format6 -> 'g2, 'b, 'c, 'j2, 'e, 'f) fmt
+
+We accept any format (('g, 'h, 'i, 'j, 'k, 'l) format6) (this is
+completely unrelated to the type of the current format), but also
+require a proof that this format is in relation to another format that
+is concatenable to the format tail. When executing a %(...%) format
+(in camlinternalFormat.ml:make_printf or scanf.ml:make_scanf), we
+transtype the format along this relation using the 'recast' function
+to transpose between related format types.
+
+  val recast :
+     ('a1, 'b1, 'c1, 'd1, 'e1, 'f1) fmt
+  -> ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+      'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+  -> ('a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmt
+
+NOTE ¹: the typing of Format_subst_ty requires not one format type, but
+two, one to establish the link between the format argument and the
+first six parameters, and the other for the link between the format
+argumant and the last six parameters.
+
+| Format_subst_ty :                                         (* %(...%) *)
+    ('g, 'h, 'i, 'j, 'k, 'l,
+     'g1, 'b1, 'c1, 'j1, 'd1, 'a1) fmtty_rel *
+    ('g, 'h, 'i, 'j, 'k, 'l,
+     'g2, 'b2, 'c2, 'j2, 'd2, 'a2) fmtty_rel *
+    ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+    (('g, 'h, 'i, 'j, 'k, 'l) format6 -> 'g1, 'b1, 'c1, 'j1, 'e1, 'f1,
+     ('g, 'h, 'i, 'j, 'k, 'l) format6 -> 'g2, 'b2, 'c2, 'j2, 'e2, 'f2) fmtty_rel
+
+When we generate a format AST, we generate exactly the same witness
+for both relations, and the witness-conversion functions in
+camlinternalFormat do rely on this invariant. For example, the
+function that proves that the relation is transitive
+
+  val trans :
+     ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+      'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+  -> ('a2, 'b2, 'c2, 'd2, 'e2, 'f2,
+      'a3, 'b3, 'c3, 'd3, 'e3, 'f3) fmtty_rel
+  -> ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+      'a3, 'b3, 'c3, 'd3, 'e3, 'f3) fmtty_rel
+
+does assume that the two input have exactly the same term structure
+(and is only every used for argument witnesses of the
+Format_subst_ty constructor).
+*)
+
+(* Type of a block used by the Format pretty-printer. *)
+type block_type =
+  | Pp_hbox   (* Horizontal block no line breaking *)
+  | Pp_vbox   (* Vertical block each break leads to a new line *)
+  | Pp_hvbox  (* Horizontal-vertical block: same as vbox, except if this block
+                 is small enough to fit on a single line *)
+  | Pp_hovbox (* Horizontal or Vertical block: breaks lead to new line
+                 only when necessary to print the content of the block *)
+  | Pp_box    (* Horizontal or Indent block: breaks lead to new line
+                 only when necessary to print the content of the block, or
+                 when it leads to a new indentation of the current line *)
+  | Pp_fits   (* Internal usage: when a block fits on a single line *)
+
+(* Formatting element used by the Format pretty-printter. *)
+type formatting_lit =
+  | Close_box                                           (* @]   *)
+  | Close_tag                                           (* @}   *)
+  | Break of string * int * int          (* @, | @  | @; | @;<> *)
+  | FFlush                                              (* @?   *)
+  | Force_newline                                       (* @\n  *)
+  | Flush_newline                                       (* @.   *)
+  | Magic_size of string * int                          (* @<n> *)
+  | Escaped_at                                          (* @@   *)
+  | Escaped_percent                                     (* @%%  *)
+  | Scan_indic of char                                  (* @X   *)
+
+(* Formatting element used by the Format pretty-printter. *)
+type ('a, 'b, 'c, 'd, 'e, 'f) formatting_gen =
+  | Open_tag : ('a, 'b, 'c, 'd, 'e, 'f) format6 ->      (* @{   *)
+    ('a, 'b, 'c, 'd, 'e, 'f) formatting_gen
+  | Open_box : ('a, 'b, 'c, 'd, 'e, 'f) format6 ->      (* @[   *)
+    ('a, 'b, 'c, 'd, 'e, 'f) formatting_gen
+
+(***)
+
+(* List of format type elements. *)
+(* In particular used to represent %(...%) and %{...%} contents. *)
+and ('a, 'b, 'c, 'd, 'e, 'f) fmtty =
+     ('a, 'b, 'c, 'd, 'e, 'f,
+      'a, 'b, 'c, 'd, 'e, 'f) fmtty_rel
+and ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel =
+  | Char_ty :                                                 (* %c  *)
+      ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+       'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+      (char -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+       char -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+  | String_ty :                                               (* %s  *)
+      ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+       'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+      (string -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+       string -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+  | Int_ty :                                                  (* %d  *)
+      ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+       'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+      (int -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+       int -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+  | Int32_ty :                                                (* %ld *)
+      ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+       'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+      (int32 -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+       int32 -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+  | Nativeint_ty :                                            (* %nd *)
+      ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+       'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+      (nativeint -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+       nativeint -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+  | Int64_ty :                                                (* %Ld *)
+      ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+       'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+      (int64 -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+       int64 -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+  | Float_ty :                                                (* %f  *)
+      ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+       'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+      (float -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+       float -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+  | Bool_ty :                                                 (* %B  *)
+      ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+       'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+      (bool -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+       bool -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+
+  | Format_arg_ty :                                           (* %{...%} *)
+      ('g, 'h, 'i, 'j, 'k, 'l) fmtty *
+      ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+       'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+      (('g, 'h, 'i, 'j, 'k, 'l) format6 -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+       ('g, 'h, 'i, 'j, 'k, 'l) format6 -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+  | Format_subst_ty :                                         (* %(...%) *)
+      ('g, 'h, 'i, 'j, 'k, 'l,
+       'g1, 'b1, 'c1, 'j1, 'd1, 'a1) fmtty_rel *
+      ('g, 'h, 'i, 'j, 'k, 'l,
+       'g2, 'b2, 'c2, 'j2, 'd2, 'a2) fmtty_rel *
+      ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+       'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+      (('g, 'h, 'i, 'j, 'k, 'l) format6 -> 'g1, 'b1, 'c1, 'j1, 'e1, 'f1,
+       ('g, 'h, 'i, 'j, 'k, 'l) format6 -> 'g2, 'b2, 'c2, 'j2, 'e2, 'f2) fmtty_rel
+
+  (* Printf and Format specific constructors. *)
+  | Alpha_ty :                                                (* %a  *)
+      ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+       'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+      (('b1 -> 'x -> 'c1) -> 'x -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+       ('b2 -> 'x -> 'c2) -> 'x -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+  | Theta_ty :                                                (* %t  *)
+      ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+       'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+      (('b1 -> 'c1) -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+       ('b2 -> 'c2) -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+
+  (* Scanf specific constructor. *)
+  | Reader_ty :                                               (* %r  *)
+      ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+       'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+      ('x -> 'a1, 'b1, 'c1, ('b1 -> 'x) -> 'd1, 'e1, 'f1,
+       'x -> 'a2, 'b2, 'c2, ('b2 -> 'x) -> 'd2, 'e2, 'f2) fmtty_rel
+  | Ignored_reader_ty :                                       (* %_r  *)
+      ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+       'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+      ('a1, 'b1, 'c1, ('b1 -> 'x) -> 'd1, 'e1, 'f1,
+       'a2, 'b2, 'c2, ('b2 -> 'x) -> 'd2, 'e2, 'f2) fmtty_rel
+
+  | End_of_fmtty :
+      ('f1, 'b1, 'c1, 'd1, 'd1, 'f1,
+       'f2, 'b2, 'c2, 'd2, 'd2, 'f2) fmtty_rel
+
+(***)
+
+(* List of format elements. *)
+and ('a, 'b, 'c, 'd, 'e, 'f) fmt =
+  | Char :                                                   (* %c *)
+      ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+        (char -> 'a, 'b, 'c, 'd, 'e, 'f) fmt
+  | Caml_char :                                              (* %C *)
+      ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+        (char -> 'a, 'b, 'c, 'd, 'e, 'f) fmt
+  | String :                                                 (* %s *)
+      ('x, string -> 'a) padding * ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+        ('x, 'b, 'c, 'd, 'e, 'f) fmt
+  | Caml_string :                                            (* %S *)
+      ('x, string -> 'a) padding * ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+        ('x, 'b, 'c, 'd, 'e, 'f) fmt
+  | Int :                                                    (* %[dixXuo] *)
+      int_conv * ('x, 'y) padding * ('y, int -> 'a) precision *
+      ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+        ('x, 'b, 'c, 'd, 'e, 'f) fmt
+  | Int32 :                                                  (* %l[dixXuo] *)
+      int_conv * ('x, 'y) padding * ('y, int32 -> 'a) precision *
+      ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+        ('x, 'b, 'c, 'd, 'e, 'f) fmt
+  | Nativeint :                                              (* %n[dixXuo] *)
+      int_conv * ('x, 'y) padding * ('y, nativeint -> 'a) precision *
+      ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+        ('x, 'b, 'c, 'd, 'e, 'f) fmt
+  | Int64 :                                                  (* %L[dixXuo] *)
+      int_conv * ('x, 'y) padding * ('y, int64 -> 'a) precision *
+      ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+        ('x, 'b, 'c, 'd, 'e, 'f) fmt
+  | Float :                                                  (* %[feEgGF] *)
+      float_conv * ('x, 'y) padding * ('y, float -> 'a) precision *
+      ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+        ('x, 'b, 'c, 'd, 'e, 'f) fmt
+  | Bool :                                                   (* %[bB] *)
+      ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+        (bool -> 'a, 'b, 'c, 'd, 'e, 'f) fmt
+  | Flush :                                                  (* %! *)
+      ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+        ('a, 'b, 'c, 'd, 'e, 'f) fmt
+
+  | String_literal :                                         (* abc *)
+      string * ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+        ('a, 'b, 'c, 'd, 'e, 'f) fmt
+  | Char_literal :                                           (* x *)
+      char * ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+        ('a, 'b, 'c, 'd, 'e, 'f) fmt
+
+  | Format_arg :                                             (* %{...%} *)
+      pad_option * ('g, 'h, 'i, 'j, 'k, 'l) fmtty *
+      ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+        (('g, 'h, 'i, 'j, 'k, 'l) format6 -> 'a, 'b, 'c, 'd, 'e, 'f) fmt
+  | Format_subst :                                           (* %(...%) *)
+      pad_option *
+      ('g, 'h, 'i, 'j, 'k, 'l,
+       'g2, 'b, 'c, 'j2, 'd, 'a) fmtty_rel *
+      ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+      (('g, 'h, 'i, 'j, 'k, 'l) format6 -> 'g2, 'b, 'c, 'j2, 'e, 'f) fmt
+
+  (* Printf and Format specific constructor. *)
+  | Alpha :                                                  (* %a *)
+      ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+        (('b -> 'x -> 'c) -> 'x -> 'a, 'b, 'c, 'd, 'e, 'f) fmt
+  | Theta :                                                  (* %t *)
+      ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+        (('b -> 'c) -> 'a, 'b, 'c, 'd, 'e, 'f) fmt
+
+  (* Format specific constructor: *)
+  | Formatting_lit :                                         (* @_ *)
+      formatting_lit * ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+        ('a, 'b, 'c, 'd, 'e, 'f) fmt
+  | Formatting_gen :                                             (* @_ *)
+      ('a1, 'b, 'c, 'd1, 'e1, 'f1) formatting_gen *
+      ('f1, 'b, 'c, 'e1, 'e2, 'f2) fmt -> ('a1, 'b, 'c, 'd1, 'e2, 'f2) fmt
+
+  (* Scanf specific constructors: *)
+  | Reader :                                                 (* %r *)
+      ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+        ('x -> 'a, 'b, 'c, ('b -> 'x) -> 'd, 'e, 'f) fmt
+  | Scan_char_set :                                          (* %[...] *)
+      pad_option * char_set * ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+        (string -> 'a, 'b, 'c, 'd, 'e, 'f) fmt
+  | Scan_get_counter :                                       (* %[nlNL] *)
+      counter * ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+        (int -> 'a, 'b, 'c, 'd, 'e, 'f) fmt
+  | Ignored_param :                                          (* %_ *)
+      ('a, 'b, 'c, 'd, 'y, 'x) ignored * ('x, 'b, 'c, 'y, 'e, 'f) fmt ->
+        ('a, 'b, 'c, 'd, 'e, 'f) fmt
+
+  | End_of_format :
+        ('f, 'b, 'c, 'e, 'e, 'f) fmt
+
+(***)
+
+(* Type for ignored parameters (see "%_"). *)
+and ('a, 'b, 'c, 'd, 'e, 'f) ignored =
+  | Ignored_char :                                           (* %_c *)
+      ('a, 'b, 'c, 'd, 'd, 'a) ignored
+  | Ignored_caml_char :                                      (* %_C *)
+      ('a, 'b, 'c, 'd, 'd, 'a) ignored
+  | Ignored_string :                                         (* %_s *)
+      pad_option -> ('a, 'b, 'c, 'd, 'd, 'a) ignored
+  | Ignored_caml_string :                                    (* %_S *)
+      pad_option -> ('a, 'b, 'c, 'd, 'd, 'a) ignored
+  | Ignored_int :                                            (* %_d *)
+      int_conv * pad_option -> ('a, 'b, 'c, 'd, 'd, 'a) ignored
+  | Ignored_int32 :                                          (* %_ld *)
+      int_conv * pad_option -> ('a, 'b, 'c, 'd, 'd, 'a) ignored
+  | Ignored_nativeint :                                      (* %_nd *)
+      int_conv * pad_option -> ('a, 'b, 'c, 'd, 'd, 'a) ignored
+  | Ignored_int64 :                                          (* %_Ld *)
+      int_conv * pad_option -> ('a, 'b, 'c, 'd, 'd, 'a) ignored
+  | Ignored_float :                                          (* %_f *)
+      pad_option * prec_option -> ('a, 'b, 'c, 'd, 'd, 'a) ignored
+  | Ignored_bool :                                           (* %_B *)
+      ('a, 'b, 'c, 'd, 'd, 'a) ignored
+  | Ignored_format_arg :                                     (* %_{...%} *)
+      pad_option * ('g, 'h, 'i, 'j, 'k, 'l) fmtty ->
+        ('a, 'b, 'c, 'd, 'd, 'a) ignored
+  | Ignored_format_subst :                                   (* %_(...%) *)
+      pad_option * ('a, 'b, 'c, 'd, 'e, 'f) fmtty ->
+        ('a, 'b, 'c, 'd, 'e, 'f) ignored
+  | Ignored_reader :                                         (* %_r *)
+      ('a, 'b, 'c, ('b -> 'x) -> 'd, 'd, 'a) ignored
+  | Ignored_scan_char_set :                                  (* %_[...] *)
+      pad_option * char_set -> ('a, 'b, 'c, 'd, 'd, 'a) ignored
+  | Ignored_scan_get_counter :                               (* %_[nlNL] *)
+      counter -> ('a, 'b, 'c, 'd, 'd, 'a) ignored
+
+and ('a, 'b, 'c, 'd, 'e, 'f) format6 =
+  Format of ('a, 'b, 'c, 'd, 'e, 'f) fmt * string
+
+let rec erase_rel : type a b c d e f g h i j k l .
+  (a, b, c, d, e, f,
+   g, h, i, j, k, l) fmtty_rel -> (a, b, c, d, e, f) fmtty
+= function
+  | Char_ty rest ->
+    Char_ty (erase_rel rest)
+  | String_ty rest ->
+    String_ty (erase_rel rest)
+  | Int_ty rest ->
+    Int_ty (erase_rel rest)
+  | Int32_ty rest ->
+    Int32_ty (erase_rel rest)
+  | Int64_ty rest ->
+    Int64_ty (erase_rel rest)
+  | Nativeint_ty rest ->
+    Nativeint_ty (erase_rel rest)
+  | Float_ty rest ->
+    Float_ty (erase_rel rest)
+  | Bool_ty rest ->
+    Bool_ty (erase_rel rest)
+  | Format_arg_ty (ty, rest) ->
+    Format_arg_ty (ty, erase_rel rest)
+  | Format_subst_ty (ty1, ty2, rest) ->
+    Format_subst_ty (ty1, ty1, erase_rel rest)
+  | Alpha_ty rest ->
+    Alpha_ty (erase_rel rest)
+  | Theta_ty rest ->
+    Theta_ty (erase_rel rest)
+  | Reader_ty rest ->
+    Reader_ty (erase_rel rest)
+  | Ignored_reader_ty rest ->
+    Ignored_reader_ty (erase_rel rest)
+  | End_of_fmtty -> End_of_fmtty
+
+(******************************************************************************)
+                         (* Format type concatenation *)
+
+(* Concatenate two format types. *)
+(* Used by:
+   * reader_nb_unifier_of_fmtty to count readers in an fmtty,
+   * Scanf.take_fmtty_format_readers to extract readers inside %(...%),
+   * CamlinternalFormat.fmtty_of_ignored_format to extract format type. *)
+
+(*
+let rec concat_fmtty : type a b c d e f g h .
+    (a, b, c, d, e, f) fmtty ->
+    (f, b, c, e, g, h) fmtty ->
+    (a, b, c, d, g, h) fmtty =
+*)
+let rec concat_fmtty :
+  type a1 b1 c1 d1 e1 f1
+       a2 b2 c2 d2 e2 f2
+       g1 j1 g2 j2
+  .
+    (g1, b1, c1, j1, d1, a1,
+     g2, b2, c2, j2, d2, a2) fmtty_rel ->
+    (a1, b1, c1, d1, e1, f1,
+     a2, b2, c2, d2, e2, f2) fmtty_rel ->
+    (g1, b1, c1, j1, e1, f1,
+     g2, b2, c2, j2, e2, f2) fmtty_rel =
+fun fmtty1 fmtty2 -> match fmtty1 with
+  | Char_ty rest ->
+    Char_ty (concat_fmtty rest fmtty2)
+  | String_ty rest ->
+    String_ty (concat_fmtty rest fmtty2)
+  | Int_ty rest ->
+    Int_ty (concat_fmtty rest fmtty2)
+  | Int32_ty rest ->
+    Int32_ty (concat_fmtty rest fmtty2)
+  | Nativeint_ty rest ->
+    Nativeint_ty (concat_fmtty rest fmtty2)
+  | Int64_ty rest ->
+    Int64_ty (concat_fmtty rest fmtty2)
+  | Float_ty rest ->
+    Float_ty (concat_fmtty rest fmtty2)
+  | Bool_ty rest ->
+    Bool_ty (concat_fmtty rest fmtty2)
+  | Alpha_ty rest ->
+    Alpha_ty (concat_fmtty rest fmtty2)
+  | Theta_ty rest ->
+    Theta_ty (concat_fmtty rest fmtty2)
+  | Reader_ty rest ->
+    Reader_ty (concat_fmtty rest fmtty2)
+  | Ignored_reader_ty rest ->
+    Ignored_reader_ty (concat_fmtty rest fmtty2)
+  | Format_arg_ty (ty, rest) ->
+    Format_arg_ty (ty, concat_fmtty rest fmtty2)
+  | Format_subst_ty (ty1, ty2, rest) ->
+    Format_subst_ty (ty1, ty2, concat_fmtty rest fmtty2)
+  | End_of_fmtty -> fmtty2
+
+(******************************************************************************)
+                           (* Format concatenation *)
+
+(* Concatenate two formats. *)
+let rec concat_fmt : type a b c d e f g h .
+    (a, b, c, d, e, f) fmt ->
+    (f, b, c, e, g, h) fmt ->
+    (a, b, c, d, g, h) fmt =
+fun fmt1 fmt2 -> match fmt1 with
+  | String (pad, rest) ->
+    String (pad, concat_fmt rest fmt2)
+  | Caml_string (pad, rest) ->
+    Caml_string (pad, concat_fmt rest fmt2)
+
+  | Int (iconv, pad, prec, rest) ->
+    Int (iconv, pad, prec, concat_fmt rest fmt2)
+  | Int32 (iconv, pad, prec, rest) ->
+    Int32 (iconv, pad, prec, concat_fmt rest fmt2)
+  | Nativeint (iconv, pad, prec, rest) ->
+    Nativeint (iconv, pad, prec, concat_fmt rest fmt2)
+  | Int64 (iconv, pad, prec, rest) ->
+    Int64 (iconv, pad, prec, concat_fmt rest fmt2)
+  | Float (fconv, pad, prec, rest) ->
+    Float (fconv, pad, prec, concat_fmt rest fmt2)
+
+  | Char (rest) ->
+    Char (concat_fmt rest fmt2)
+  | Caml_char rest ->
+    Caml_char (concat_fmt rest fmt2)
+  | Bool rest ->
+    Bool (concat_fmt rest fmt2)
+  | Alpha rest ->
+    Alpha (concat_fmt rest fmt2)
+  | Theta rest ->
+    Theta (concat_fmt rest fmt2)
+  | Reader rest ->
+    Reader (concat_fmt rest fmt2)
+  | Flush rest ->
+    Flush (concat_fmt rest fmt2)
+
+  | String_literal (str, rest) ->
+    String_literal (str, concat_fmt rest fmt2)
+  | Char_literal (chr, rest) ->
+    Char_literal   (chr, concat_fmt rest fmt2)
+
+  | Format_arg (pad, fmtty, rest) ->
+    Format_arg   (pad, fmtty, concat_fmt rest fmt2)
+  | Format_subst (pad, fmtty, rest) ->
+    Format_subst (pad, fmtty, concat_fmt rest fmt2)
+
+  | Scan_char_set (width_opt, char_set, rest) ->
+    Scan_char_set (width_opt, char_set, concat_fmt rest fmt2)
+  | Scan_get_counter (counter, rest) ->
+    Scan_get_counter (counter, concat_fmt rest fmt2)
+  | Ignored_param (ign, rest) ->
+    Ignored_param (ign, concat_fmt rest fmt2)
+
+  | Formatting_lit (fmting_lit, rest) ->
+    Formatting_lit (fmting_lit, concat_fmt rest fmt2)
+  | Formatting_gen (fmting_gen, rest) ->
+    Formatting_gen (fmting_gen, concat_fmt rest fmt2)
+
+  | End_of_format ->
+    fmt2
diff --git a/stdlib/camlinternalFormatBasics.mli b/stdlib/camlinternalFormatBasics.mli
new file mode 100644
index 0000000000..52f428ad83
--- /dev/null
+++ b/stdlib/camlinternalFormatBasics.mli
@@ -0,0 +1,287 @@
+(* No comments, OCaml stdlib internal use only. *)
+
+type padty = Left | Right | Zeros
+
+type int_conv =
+  | Int_d | Int_pd | Int_sd | Int_i | Int_pi | Int_si
+  | Int_x | Int_Cx | Int_X | Int_CX | Int_o | Int_Co | Int_u
+
+type float_conv =
+  | Float_f | Float_pf | Float_sf | Float_e | Float_pe | Float_se
+  | Float_E | Float_pE | Float_sE | Float_g | Float_pg | Float_sg
+  | Float_G | Float_pG | Float_sG | Float_F
+
+type char_set = string
+
+type counter = Line_counter | Char_counter | Token_counter
+
+type ('a, 'b) padding =
+  | No_padding  : ('a, 'a) padding
+  | Lit_padding : padty * int -> ('a, 'a) padding
+  | Arg_padding : padty -> (int -> 'a, 'a) padding
+
+type pad_option = int option
+
+type ('a, 'b) precision =
+  | No_precision : ('a, 'a) precision
+  | Lit_precision : int -> ('a, 'a) precision
+  | Arg_precision : (int -> 'a, 'a) precision
+
+type prec_option = int option
+
+type block_type = Pp_hbox | Pp_vbox | Pp_hvbox | Pp_hovbox | Pp_box | Pp_fits
+
+type formatting_lit =
+  | Close_box
+  | Close_tag
+  | Break of string * int * int
+  | FFlush
+  | Force_newline
+  | Flush_newline
+  | Magic_size of string * int
+  | Escaped_at
+  | Escaped_percent
+  | Scan_indic of char
+
+type ('a, 'b, 'c, 'd, 'e, 'f) formatting_gen =
+  | Open_tag : ('a, 'b, 'c, 'd, 'e, 'f) format6 ->
+    ('a, 'b, 'c, 'd, 'e, 'f) formatting_gen
+  | Open_box : ('a, 'b, 'c, 'd, 'e, 'f) format6 ->
+    ('a, 'b, 'c, 'd, 'e, 'f) formatting_gen
+
+and ('a, 'b, 'c, 'd, 'e, 'f) fmtty =
+    ('a, 'b, 'c, 'd, 'e, 'f,
+     'a, 'b, 'c, 'd, 'e, 'f) fmtty_rel
+and ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+   'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel =
+| Char_ty :                                                 (* %c  *)
+    ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+    (char -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     char -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+| String_ty :                                               (* %s  *)
+    ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+    (string -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     string -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+| Int_ty :                                                  (* %d  *)
+    ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+    (int -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     int -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+| Int32_ty :                                                (* %ld *)
+    ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+    (int32 -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     int32 -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+| Nativeint_ty :                                            (* %nd *)
+    ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+    (nativeint -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     nativeint -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+| Int64_ty :                                                (* %Ld *)
+    ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+    (int64 -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     int64 -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+| Float_ty :                                                (* %f  *)
+    ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+    (float -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     float -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+| Bool_ty :                                                 (* %B  *)
+    ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+    (bool -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     bool -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+| Format_arg_ty :                                           (* %{...%} *)
+    ('g, 'h, 'i, 'j, 'k, 'l) fmtty *
+    ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+    (('g, 'h, 'i, 'j, 'k, 'l) format6 -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     ('g, 'h, 'i, 'j, 'k, 'l) format6 -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+| Format_subst_ty :                                         (* %(...%) *)
+    ('g, 'h, 'i, 'j, 'k, 'l,
+     'g1, 'b1, 'c1, 'j1, 'd1, 'a1) fmtty_rel *
+    ('g, 'h, 'i, 'j, 'k, 'l,
+     'g2, 'b2, 'c2, 'j2, 'd2, 'a2) fmtty_rel *
+    ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+    (('g, 'h, 'i, 'j, 'k, 'l) format6 -> 'g1, 'b1, 'c1, 'j1, 'e1, 'f1,
+     ('g, 'h, 'i, 'j, 'k, 'l) format6 -> 'g2, 'b2, 'c2, 'j2, 'e2, 'f2) fmtty_rel
+
+(* Printf and Format specific constructors. *)
+| Alpha_ty :                                                (* %a  *)
+    ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+    (('b1 -> 'x -> 'c1) -> 'x -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     ('b2 -> 'x -> 'c2) -> 'x -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+| Theta_ty :                                                (* %t  *)
+    ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+    (('b1 -> 'c1) -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     ('b2 -> 'c2) -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+
+(* Scanf specific constructor. *)
+| Reader_ty :                                               (* %r  *)
+    ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+    ('x -> 'a1, 'b1, 'c1, ('b1 -> 'x) -> 'd1, 'e1, 'f1,
+     'x -> 'a2, 'b2, 'c2, ('b2 -> 'x) -> 'd2, 'e2, 'f2) fmtty_rel
+| Ignored_reader_ty :                                       (* %_r  *)
+    ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+    ('a1, 'b1, 'c1, ('b1 -> 'x) -> 'd1, 'e1, 'f1,
+     'a2, 'b2, 'c2, ('b2 -> 'x) -> 'd2, 'e2, 'f2) fmtty_rel
+
+| End_of_fmtty :
+    ('f1, 'b1, 'c1, 'd1, 'd1, 'f1,
+     'f2, 'b2, 'c2, 'd2, 'd2, 'f2) fmtty_rel
+
+(**)
+
+(** List of format elements. *)
+and ('a, 'b, 'c, 'd, 'e, 'f) fmt =
+| Char :                                                   (* %c *)
+    ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+      (char -> 'a, 'b, 'c, 'd, 'e, 'f) fmt
+| Caml_char :                                              (* %C *)
+    ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+      (char -> 'a, 'b, 'c, 'd, 'e, 'f) fmt
+| String :                                                 (* %s *)
+    ('x, string -> 'a) padding * ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+      ('x, 'b, 'c, 'd, 'e, 'f) fmt
+| Caml_string :                                            (* %S *)
+    ('x, string -> 'a) padding * ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+      ('x, 'b, 'c, 'd, 'e, 'f) fmt
+| Int :                                                    (* %[dixXuo] *)
+    int_conv * ('x, 'y) padding * ('y, int -> 'a) precision *
+    ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+      ('x, 'b, 'c, 'd, 'e, 'f) fmt
+| Int32 :                                                  (* %l[dixXuo] *)
+    int_conv * ('x, 'y) padding * ('y, int32 -> 'a) precision *
+    ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+      ('x, 'b, 'c, 'd, 'e, 'f) fmt
+| Nativeint :                                              (* %n[dixXuo] *)
+    int_conv * ('x, 'y) padding * ('y, nativeint -> 'a) precision *
+    ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+      ('x, 'b, 'c, 'd, 'e, 'f) fmt
+| Int64 :                                                  (* %L[dixXuo] *)
+    int_conv * ('x, 'y) padding * ('y, int64 -> 'a) precision *
+    ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+      ('x, 'b, 'c, 'd, 'e, 'f) fmt
+| Float :                                                  (* %[feEgGF] *)
+    float_conv * ('x, 'y) padding * ('y, float -> 'a) precision *
+    ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+      ('x, 'b, 'c, 'd, 'e, 'f) fmt
+| Bool :                                                   (* %[bB] *)
+    ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+      (bool -> 'a, 'b, 'c, 'd, 'e, 'f) fmt
+| Flush :                                                  (* %! *)
+    ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+      ('a, 'b, 'c, 'd, 'e, 'f) fmt
+
+| String_literal :                                         (* abc *)
+    string * ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+      ('a, 'b, 'c, 'd, 'e, 'f) fmt
+| Char_literal :                                           (* x *)
+    char * ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+      ('a, 'b, 'c, 'd, 'e, 'f) fmt
+
+| Format_arg :                                             (* %{...%} *)
+    pad_option * ('g, 'h, 'i, 'j, 'k, 'l) fmtty *
+    ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+      (('g, 'h, 'i, 'j, 'k, 'l) format6 -> 'a, 'b, 'c, 'd, 'e, 'f) fmt
+| Format_subst :                                           (* %(...%) *)
+    pad_option *
+    ('g, 'h, 'i, 'j, 'k, 'l,
+     'g2, 'b, 'c, 'j2, 'd, 'a) fmtty_rel *
+    ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+    (('g, 'h, 'i, 'j, 'k, 'l) format6 -> 'g2, 'b, 'c, 'j2, 'e, 'f) fmt
+
+(* Printf and Format specific constructor. *)
+| Alpha :                                                  (* %a *)
+    ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+      (('b -> 'x -> 'c) -> 'x -> 'a, 'b, 'c, 'd, 'e, 'f) fmt
+| Theta :                                                  (* %t *)
+    ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+      (('b -> 'c) -> 'a, 'b, 'c, 'd, 'e, 'f) fmt
+
+(* Format specific constructor: *)
+| Formatting_lit :                                         (* @_ *)
+    formatting_lit * ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+      ('a, 'b, 'c, 'd, 'e, 'f) fmt
+| Formatting_gen :                                             (* @_ *)
+    ('a1, 'b, 'c, 'd1, 'e1, 'f1) formatting_gen *
+    ('f1, 'b, 'c, 'e1, 'e2, 'f2) fmt -> ('a1, 'b, 'c, 'd1, 'e2, 'f2) fmt
+
+(* Scanf specific constructors: *)
+| Reader :                                                 (* %r *)
+    ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+      ('x -> 'a, 'b, 'c, ('b -> 'x) -> 'd, 'e, 'f) fmt
+| Scan_char_set :                                          (* %[...] *)
+    pad_option * char_set * ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+      (string -> 'a, 'b, 'c, 'd, 'e, 'f) fmt
+| Scan_get_counter :                                       (* %[nlNL] *)
+    counter * ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+      (int -> 'a, 'b, 'c, 'd, 'e, 'f) fmt
+| Ignored_param :                                          (* %_ *)
+    ('a, 'b, 'c, 'd, 'y, 'x) ignored * ('x, 'b, 'c, 'y, 'e, 'f) fmt ->
+      ('a, 'b, 'c, 'd, 'e, 'f) fmt
+
+| End_of_format :
+      ('f, 'b, 'c, 'e, 'e, 'f) fmt
+
+and ('a, 'b, 'c, 'd, 'e, 'f) ignored =
+  | Ignored_char :
+      ('a, 'b, 'c, 'd, 'd, 'a) ignored
+  | Ignored_caml_char :
+      ('a, 'b, 'c, 'd, 'd, 'a) ignored
+  | Ignored_string :
+      pad_option -> ('a, 'b, 'c, 'd, 'd, 'a) ignored
+  | Ignored_caml_string :
+      pad_option -> ('a, 'b, 'c, 'd, 'd, 'a) ignored
+  | Ignored_int :
+      int_conv * pad_option -> ('a, 'b, 'c, 'd, 'd, 'a) ignored
+  | Ignored_int32 :
+      int_conv * pad_option -> ('a, 'b, 'c, 'd, 'd, 'a) ignored
+  | Ignored_nativeint :
+      int_conv * pad_option -> ('a, 'b, 'c, 'd, 'd, 'a) ignored
+  | Ignored_int64 :
+      int_conv * pad_option -> ('a, 'b, 'c, 'd, 'd, 'a) ignored
+  | Ignored_float :
+      pad_option * prec_option -> ('a, 'b, 'c, 'd, 'd, 'a) ignored
+  | Ignored_bool :
+      ('a, 'b, 'c, 'd, 'd, 'a) ignored
+  | Ignored_format_arg :
+      pad_option * ('g, 'h, 'i, 'j, 'k, 'l) fmtty ->
+        ('a, 'b, 'c, 'd, 'd, 'a) ignored
+  | Ignored_format_subst :
+      pad_option * ('a, 'b, 'c, 'd, 'e, 'f) fmtty ->
+        ('a, 'b, 'c, 'd, 'e, 'f) ignored
+  | Ignored_reader :
+      ('a, 'b, 'c, ('b -> 'x) -> 'd, 'd, 'a) ignored
+  | Ignored_scan_char_set :
+      pad_option * char_set -> ('a, 'b, 'c, 'd, 'd, 'a) ignored
+  | Ignored_scan_get_counter :
+      counter -> ('a, 'b, 'c, 'd, 'd, 'a) ignored
+
+and ('a, 'b, 'c, 'd, 'e, 'f) format6 =
+  Format of ('a, 'b, 'c, 'd, 'e, 'f) fmt * string
+
+val concat_fmtty :
+  ('g1, 'b1, 'c1, 'j1, 'd1, 'a1,
+   'g2, 'b2, 'c2, 'j2, 'd2, 'a2) fmtty_rel ->
+  ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+   'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+  ('g1, 'b1, 'c1, 'j1, 'e1, 'f1,
+   'g2, 'b2, 'c2, 'j2, 'e2, 'f2) fmtty_rel
+
+val erase_rel :
+  ('a, 'b, 'c, 'd, 'e, 'f,
+   'g, 'h, 'i, 'j, 'k, 'l) fmtty_rel -> ('a, 'b, 'c, 'd, 'e, 'f) fmtty
+
+val concat_fmt :
+    ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+    ('f, 'b, 'c, 'e, 'g, 'h) fmt ->
+    ('a, 'b, 'c, 'd, 'g, 'h) fmt
diff --git a/stdlib/digest.ml b/stdlib/digest.ml
index 7c607ee1f8..14cb4ebd90 100644
--- a/stdlib/digest.ml
+++ b/stdlib/digest.ml
@@ -23,11 +23,15 @@ external channel: in_channel -> int -> t = "caml_md5_chan"
 let string str =
   unsafe_string str 0 (String.length str)
 
+let bytes b = string (Bytes.unsafe_to_string b)
+
 let substring str ofs len =
   if ofs < 0 || len < 0 || ofs > String.length str - len
   then invalid_arg "Digest.substring"
   else unsafe_string str ofs len
 
+let subbytes b ofs len = substring (Bytes.unsafe_to_string b) ofs len
+
 let file filename =
   let ic = open_in_bin filename in
   let d = channel ic (-1) in
@@ -35,24 +39,21 @@ let file filename =
   d
 
 let output chan digest =
-  output chan digest 0 16
+  output_string chan digest
 
-let input chan =
-  let digest = String.create 16 in
-  really_input chan digest 0 16;
-  digest
+let input chan = really_input_string chan 16
 
 let char_hex n =
   Char.unsafe_chr (n + if n < 10 then Char.code '0' else (Char.code 'a' - 10))
 
 let to_hex d =
-  let result = String.create 32 in
+  let result = Bytes.create 32 in
   for i = 0 to 15 do
     let x = Char.code d.[i] in
-    String.unsafe_set result (i*2) (char_hex (x lsr 4));
-    String.unsafe_set result (i*2+1) (char_hex (x land 0x0f));
+    Bytes.unsafe_set result (i*2) (char_hex (x lsr 4));
+    Bytes.unsafe_set result (i*2+1) (char_hex (x land 0x0f));
   done;
-  result
+  Bytes.unsafe_to_string result
 
 let from_hex s =
   if String.length s <> 32 then raise (Invalid_argument "Digest.from_hex");
@@ -64,8 +65,8 @@ let from_hex s =
     | _ -> raise (Invalid_argument "Digest.from_hex")
   in
   let byte i = digit s.[i] lsl 4 + digit s.[i+1] in
-  let result = String.create 16 in
+  let result = Bytes.create 16 in
   for i = 0 to 15 do
-    result.[i] <- Char.chr (byte (2 * i));
+    Bytes.set result i (Char.chr (byte (2 * i)));
   done;
-  result
+  Bytes.unsafe_to_string result
diff --git a/stdlib/digest.mli b/stdlib/digest.mli
index 7fa1f15d62..583d2a46b0 100644
--- a/stdlib/digest.mli
+++ b/stdlib/digest.mli
@@ -36,10 +36,16 @@ val compare : t -> t -> int
 val string : string -> t
 (** Return the digest of the given string. *)
 
+val bytes : bytes -> t
+(** Return the digest of the given byte sequence. *)
+
 val substring : string -> int -> int -> t
 (** [Digest.substring s ofs len] returns the digest of the substring
-   of [s] starting at character number [ofs] and containing [len]
-   characters. *)
+   of [s] starting at index [ofs] and containing [len] characters. *)
+
+val subbytes : bytes -> int -> int -> t
+(** [Digest.subbytes s ofs len] returns the digest of the subsequence
+   of [s] starting at index [ofs] and containing [len] bytes. *)
 
 external channel : in_channel -> int -> t = "caml_md5_chan"
 (** If [len] is nonnegative, [Digest.channel ic len] reads [len]
diff --git a/stdlib/format.ml b/stdlib/format.ml
index 02222932e4..55674d179b 100644
--- a/stdlib/format.ml
+++ b/stdlib/format.ml
@@ -29,6 +29,10 @@ external int_of_size : size -> int = "%identity"
 
 (* Tokens are one of the following : *)
 
+type block_type
+       = CamlinternalFormatBasics.block_type
+       = Pp_hbox | Pp_vbox | Pp_hvbox | Pp_hovbox | Pp_box | Pp_fits
+
 type pp_token =
 | Pp_text of string            (* normal text *)
 | Pp_break of int * int        (* complete break *)
@@ -46,21 +50,7 @@ type pp_token =
 
 and tag = string
 
-and block_type =
-| Pp_hbox   (* Horizontal block no line breaking *)
-| Pp_vbox   (* Vertical block each break leads to a new line *)
-| Pp_hvbox  (* Horizontal-vertical block: same as vbox, except if this block
-               is small enough to fit on a single line *)
-| Pp_hovbox (* Horizontal or Vertical block: breaks lead to new line
-               only when necessary to print the content of the block *)
-| Pp_box    (* Horizontal or Indent block: breaks lead to new line
-               only when necessary to print the content of the block, or
-               when it leads to a new indentation of the current line *)
-| Pp_fits   (* Internal usage: when a block fits on a single line *)
-
-and tblock =
-  | Pp_tbox of int list ref  (* Tabulation box *)
-;;
+and tblock = Pp_tbox of int list ref  (* Tabulation box *)
 
 (* The Queue:
    contains all formatting elements.
@@ -241,7 +231,6 @@ let pp_infinity = 1000000010;;
 let pp_output_string state s = state.pp_out_string s 0 (String.length s)
 and pp_output_newline state = state.pp_out_newline ()
 and pp_output_spaces state n = state.pp_out_spaces n
-;;
 
 (* To format a break, indenting a new line. *)
 let break_new_line state offset width =
@@ -657,9 +646,7 @@ let pp_print_bool state b = pp_print_string state (string_of_bool b);;
 
 (* To format a char. *)
 let pp_print_char state c =
-  let s = String.create 1 in
-  s.[0] <- c;
-  pp_print_as state 1 s
+  pp_print_as state 1 (String.make 1 c)
 ;;
 
 (* Opening boxes. *)
@@ -901,7 +888,7 @@ let rec display_blanks state n =
 ;;
 
 let pp_set_formatter_out_channel state os =
-  state.pp_out_string <- output os;
+  state.pp_out_string <- output_substring os;
   state.pp_out_flush <- (fun () -> flush os);
   state.pp_out_newline <- display_newline state;
   state.pp_out_spaces <- display_blanks state;
@@ -967,7 +954,7 @@ let make_formatter output flush =
 ;;
 
 let formatter_of_out_channel oc =
-  make_formatter (output oc) (fun () -> flush oc)
+  make_formatter (output_substring oc) (fun () -> flush oc)
 ;;
 
 let formatter_of_buffer b =
@@ -1071,309 +1058,98 @@ and set_tags =
   pp_set_tags std_formatter
 ;;
 
-
-(**************************************************************
-
-  Printf implementation.
-
- **************************************************************)
-
-module Sformat = Printf.CamlinternalPr.Sformat;;
-module Tformat = Printf.CamlinternalPr.Tformat;;
-
-(* Error messages when processing formats. *)
-
-(* Trailer: giving up at character number ... *)
-let giving_up mess fmt i =
-  Printf.sprintf
-    "Format.fprintf: %s \'%s\', giving up at character number %d%s"
-    mess (Sformat.to_string fmt) i
-    (if i < Sformat.length fmt
-     then Printf.sprintf " (%c)." (Sformat.get fmt i)
-     else Printf.sprintf "%c" '.')
-;;
-
-(* When an invalid format deserves a special error explanation. *)
-let format_invalid_arg mess fmt i = invalid_arg (giving_up mess fmt i);;
-
-(* Standard invalid format. *)
-let invalid_format fmt i = format_invalid_arg "bad format" fmt i;;
-
-(* Cannot find a valid integer into that format. *)
-let invalid_integer fmt i =
-  invalid_arg (giving_up "bad integer specification" fmt i);;
-
-(* Finding an integer size out of a sub-string of the format. *)
-let format_int_of_string fmt i s =
-  let sz =
-    try int_of_string s with
-    | Failure _ -> invalid_integer fmt i in
-  size_of_int sz
-;;
-
-(* Getting strings out of buffers. *)
-let get_buffer_out b =
-  let s = Buffer.contents b in
-  Buffer.reset b;
-  s
-;;
-
-(* [ppf] is supposed to be a pretty-printer that outputs to buffer [b]:
-   to extract the contents of [ppf] as a string we flush [ppf] and get the
-   string out of [b]. *)
-let string_out b ppf =
-  pp_flush_queue ppf false;
-  get_buffer_out b
-;;
-
-(* Applies [printer] to a formatter that outputs on a fresh buffer,
-   then returns the resulting material. *)
-let exstring printer arg =
-  let b = Buffer.create 512 in
-  let ppf = formatter_of_buffer b in
-  printer ppf arg;
-  string_out b ppf
-;;
-
-(* To turn out a character accumulator into the proper string result. *)
-let implode_rev s0 = function
-  | [] -> s0
-  | l -> String.concat "" (List.rev (s0 :: l))
-;;
-
-(* [mkprintf] is the printf-like function generator: given the
-   - [to_s] flag that tells if we are printing into a string,
-   - the [get_out] function that has to be called to get a [ppf] function to
-     output onto,
-   it generates a [kprintf] function that takes as arguments a [k]
-   continuation function to be called at the end of formatting,
-   and a printing format string to print the rest of the arguments
-   according to the format string.
-   Regular [fprintf]-like functions of this module are obtained via partial
-   applications of [mkprintf]. *)
-let mkprintf to_s get_out k fmt =
-
-  (* [out] is global to this definition of [pr], and must be shared by all its
-     recursive calls (if any). *)
-  let out = get_out fmt in
-  let print_as = ref None in
-  let outc c =
-    match !print_as with
-    | None -> pp_print_char out c
-    | Some size ->
-      pp_print_as_size out size (String.make 1 c);
-      print_as := None
-  and outs s =
-    match !print_as with
-    | None -> pp_print_string out s
-    | Some size ->
-      pp_print_as_size out size s;
-      print_as := None
-  and flush out = pp_print_flush out () in
-
-  let rec pr k n fmt v =
-
-    let len = Sformat.length fmt in
-
-    let rec doprn n i =
-      if i >= len then Obj.magic (k out) else
-      match Sformat.get fmt i with
-      | '%' ->
-        Tformat.scan_format fmt v n i cont_s cont_a cont_t cont_f cont_m
-      | '@' ->
-        let i = succ i in
-        if i >= len then invalid_format fmt i else
-        begin match Sformat.get fmt i with
-        | '[' ->
-          do_pp_open_box out n (succ i)
-        | ']' ->
-          pp_close_box out ();
-          doprn n (succ i)
-        | '{' ->
-          do_pp_open_tag out n (succ i)
-        | '}' ->
-          pp_close_tag out ();
-          doprn n (succ i)
-        | ' ' ->
-          pp_print_space out ();
-          doprn n (succ i)
-        | ',' ->
-          pp_print_cut out ();
-          doprn n (succ i)
-        | '?' ->
-          pp_print_flush out ();
-          doprn n (succ i)
-        | '.' ->
-          pp_print_newline out ();
-          doprn n (succ i)
-        | '\n' ->
-          pp_force_newline out ();
-          doprn n (succ i)
-        | ';' ->
-          do_pp_break out n (succ i)
-        | '<' ->
-          let got_size size n i =
-            print_as := Some size;
-            doprn n (skip_gt i) in
-          get_int n (succ i) got_size
-        | '@' ->
-          outc '@';
-          doprn n (succ i)
-        | _ -> invalid_format fmt i
-        end
-      | c -> outc c; doprn n (succ i)
-
-    and cont_s n s i =
-      outs s; doprn n i
-    and cont_a n printer arg i =
-      if to_s then
-        outs ((Obj.magic printer : unit -> _ -> string) () arg)
-      else
-        printer out arg;
-      doprn n i
-    and cont_t n printer i =
-      if to_s then
-        outs ((Obj.magic printer : unit -> string) ())
-      else
-        printer out;
-      doprn n i
-    and cont_f n i =
-      flush out; doprn n i
-    and cont_m n xf i =
-      let m =
-        Sformat.add_int_index
-          (Tformat.count_printing_arguments_of_format xf) n in
-      pr (Obj.magic (fun _ -> doprn m i)) n xf v
-
-    and get_int n i c =
-      if i >= len then invalid_integer fmt i else
-      match Sformat.get fmt i with
-      | ' ' -> get_int n (succ i) c
-      | '%' ->
-        let cont_s n s i = c (format_int_of_string fmt i s) n i
-        and cont_a _n _printer _arg i = invalid_integer fmt i
-        and cont_t _n _printer i = invalid_integer fmt i
-        and cont_f _n i = invalid_integer fmt i
-        and cont_m _n _sfmt i = invalid_integer fmt i in
-        Tformat.scan_format fmt v n i cont_s cont_a cont_t cont_f cont_m
-      | _ ->
-        let rec get j =
-          if j >= len then invalid_integer fmt j else
-          match Sformat.get fmt j with
-          | '0' .. '9' | '-' -> get (succ j)
-          | _ ->
-            let size =
-              if j = i then size_of_int 0 else
-              let s = Sformat.sub fmt (Sformat.index_of_int i) (j - i) in
-              format_int_of_string fmt j s in
-            c size n j in
-        get i
-
-    and skip_gt i =
-      if i >= len then invalid_format fmt i else
-      match Sformat.get fmt i with
-      | ' ' -> skip_gt (succ i)
-      | '>' -> succ i
-      | _ -> invalid_format fmt i
-
-    and get_box_kind i =
-      if i >= len then Pp_box, i else
-      match Sformat.get fmt i with
-      | 'h' ->
-         let i = succ i in
-         if i >= len then Pp_hbox, i else
-         begin match Sformat.get fmt i with
-         | 'o' ->
-           let i = succ i in
-           if i >= len then format_invalid_arg "bad box format" fmt i else
-           begin match Sformat.get fmt i with
-           | 'v' -> Pp_hovbox, succ i
-           | c ->
-             format_invalid_arg
-               ("bad box name ho" ^ String.make 1 c) fmt i
-           end
-         | 'v' -> Pp_hvbox, succ i
-         | _ -> Pp_hbox, i
-         end
-      | 'b' -> Pp_box, succ i
-      | 'v' -> Pp_vbox, succ i
-      | _ -> Pp_box, i
-
-    and get_tag_name n i c =
-      let rec get accu n i j =
-        if j >= len then
-          c (implode_rev
-               (Sformat.sub fmt (Sformat.index_of_int i) (j - i))
-               accu)
-            n j else
-        match Sformat.get fmt j with
-        | '>' ->
-          c (implode_rev
-               (Sformat.sub fmt (Sformat.index_of_int i) (j - i))
-               accu)
-            n j
-        | '%' ->
-          let s0 = Sformat.sub fmt (Sformat.index_of_int i) (j - i) in
-          let cont_s n s i = get (s :: s0 :: accu) n i i
-          and cont_a n printer arg i =
-            let s =
-              if to_s
-              then (Obj.magic printer : unit -> _ -> string) () arg
-              else exstring printer arg in
-            get (s :: s0 :: accu) n i i
-          and cont_t n printer i =
-            let s =
-              if to_s
-              then (Obj.magic printer : unit -> string) ()
-              else exstring (fun ppf () -> printer ppf) () in
-            get (s :: s0 :: accu) n i i
-          and cont_f _n i =
-            format_invalid_arg "bad tag name specification" fmt i
-          and cont_m _n _sfmt i =
-            format_invalid_arg "bad tag name specification" fmt i in
-          Tformat.scan_format fmt v n j cont_s cont_a cont_t cont_f cont_m
-        | _ -> get accu n i (succ j) in
-      get [] n i i
-
-    and do_pp_break ppf n i =
-      if i >= len then begin pp_print_space ppf (); doprn n i end else
-      match Sformat.get fmt i with
-      | '<' ->
-        let rec got_nspaces nspaces n i =
-          get_int n i (got_offset nspaces)
-        and got_offset nspaces offset n i =
-          pp_print_break ppf (int_of_size nspaces) (int_of_size offset);
-          doprn n (skip_gt i) in
-        get_int n (succ i) got_nspaces
-      | _c -> pp_print_space ppf (); doprn n i
-
-    and do_pp_open_box ppf n i =
-      if i >= len then begin pp_open_box_gen ppf 0 Pp_box; doprn n i end else
-      match Sformat.get fmt i with
-      | '<' ->
-        let kind, i = get_box_kind (succ i) in
-        let got_size size n i =
-          pp_open_box_gen ppf (int_of_size size) kind;
-          doprn n (skip_gt i) in
-        get_int n i got_size
-      | _c -> pp_open_box_gen ppf 0 Pp_box; doprn n i
-
-    and do_pp_open_tag ppf n i =
-      if i >= len then begin pp_open_tag ppf ""; doprn n i end else
-      match Sformat.get fmt i with
-      | '<' ->
-        let got_name tag_name n i =
-          pp_open_tag ppf tag_name;
-          doprn n (skip_gt i) in
-        get_tag_name n (succ i) got_name
-      | _c -> pp_open_tag ppf ""; doprn n i in
-
-    doprn n 0 in
-
-  let kpr = pr k (Sformat.index_of_int 0) in
-
-  Tformat.kapr kpr fmt
-;;
+ (**************************************************************)
+
+let compute_tag output tag_acc =
+  let buf = Buffer.create 16 in
+  let ppf = formatter_of_buffer buf in
+  let () = output ppf tag_acc in
+  let () = pp_print_flush ppf () in
+  let len = Buffer.length buf in
+  if len < 2 then Buffer.contents buf
+  else Buffer.sub buf 1 (len - 2)
+
+ (**************************************************************
+ 
+  Defining continuations to be passed as arguments of
+  CamlinternalFormat.make_printf.
+ 
+  **************************************************************)
+
+open CamlinternalFormatBasics
+open CamlinternalFormat
+
+(* Interpret a formatting entity on a formatter. *)
+let output_formatting_lit ppf fmting_lit = match fmting_lit with
+  | Close_box                 -> pp_close_box ppf ()
+  | Close_tag                 -> pp_close_tag ppf ()
+  | Break (_, width, offset)  -> pp_print_break ppf width offset
+  | FFlush                    -> pp_print_flush ppf ()
+  | Force_newline             -> pp_force_newline ppf ()
+  | Flush_newline             -> pp_print_newline ppf ()
+  | Magic_size (_, _)         -> ()
+  | Escaped_at                -> pp_print_char ppf '@'
+  | Escaped_percent           -> pp_print_char ppf '%'
+  | Scan_indic c              -> pp_print_char ppf '@'; pp_print_char ppf c
+
+(* Recursively output an "accumulator" containing a reversed list of
+   printing entities (string, char, flus, ...) in an output_stream. *)
+(* Differ from Printf.output_acc by the interpretation of formatting. *)
+(* Used as a continuation of CamlinternalFormat.make_printf. *)
+let rec output_acc ppf acc = match acc with
+  | Acc_string (Acc_formatting_lit (p, Magic_size (_, size)), s) ->
+    output_acc ppf p;
+    pp_print_as_size ppf (size_of_int size) s;
+  | Acc_char (Acc_formatting_lit (p, Magic_size (_, size)), c) ->
+    output_acc ppf p;
+    pp_print_as_size ppf (size_of_int size) (String.make 1 c);
+  | Acc_formatting_lit (p, f) ->
+    output_acc ppf p;
+    output_formatting_lit ppf f;
+  | Acc_formatting_gen (p, Acc_open_tag acc') ->
+    output_acc ppf p;
+    pp_open_tag ppf (compute_tag output_acc acc')
+  | Acc_formatting_gen (p, Acc_open_box acc') ->
+    let () = output_acc ppf p in
+    let (indent, bty) = open_box_of_string (compute_tag output_acc acc') in
+    pp_open_box_gen ppf indent bty
+  | Acc_string (p, s)        -> output_acc ppf p; pp_print_string ppf s;
+  | Acc_char (p, c)          -> output_acc ppf p; pp_print_char ppf c;
+  | Acc_delay (p, f)         -> output_acc ppf p; f ppf;
+  | Acc_flush p              -> output_acc ppf p; pp_print_flush ppf ();
+  | Acc_invalid_arg (p, msg) -> output_acc ppf p; invalid_arg msg;
+  | End_of_acc               -> ()
+
+(* Recursively output an "accumulator" containing a reversed list of
+   printing entities (string, char, flus, ...) in a buffer. *)
+(* Differ from Printf.bufput_acc by the interpretation of formatting. *)
+(* Used as a continuation of CamlinternalFormat.make_printf. *)
+let rec strput_acc ppf acc = match acc with
+  | Acc_string (Acc_formatting_lit (p, Magic_size (_, size)), s) ->
+    strput_acc ppf p;
+    pp_print_as_size ppf (size_of_int size) s;
+  | Acc_char (Acc_formatting_lit (p, Magic_size (_, size)), c) ->
+    strput_acc ppf p;
+    pp_print_as_size ppf (size_of_int size) (String.make 1 c);
+  | Acc_delay (Acc_formatting_lit (p, Magic_size (_, size)), f) ->
+    strput_acc ppf p;
+    pp_print_as_size ppf (size_of_int size) (f ());
+  | Acc_formatting_lit (p, f) ->
+    strput_acc ppf p;
+    output_formatting_lit ppf f;
+  | Acc_formatting_gen (p, Acc_open_tag acc') ->
+    strput_acc ppf p;
+    pp_open_tag ppf (compute_tag strput_acc acc')
+  | Acc_formatting_gen (p, Acc_open_box acc') ->
+    let () = strput_acc ppf p in
+    let (indent, bty) = open_box_of_string (compute_tag strput_acc acc') in
+    pp_open_box_gen ppf indent bty
+  | Acc_string (p, s)        -> strput_acc ppf p; pp_print_string ppf s;
+  | Acc_char (p, c)          -> strput_acc ppf p; pp_print_char ppf c;
+  | Acc_delay (p, f)         -> strput_acc ppf p; pp_print_string ppf (f ());
+  | Acc_flush p              -> strput_acc ppf p; pp_print_flush ppf ();
+  | Acc_invalid_arg (p, msg) -> strput_acc ppf p; invalid_arg msg;
+  | End_of_acc               -> ()
 
 (**************************************************************
 
@@ -1381,30 +1157,37 @@ let mkprintf to_s get_out k fmt =
 
  **************************************************************)
 
-let kfprintf k ppf = mkprintf false (fun _ -> ppf) k;;
-let ikfprintf k ppf = Tformat.kapr (fun _ _ -> Obj.magic (k ppf));;
-
-let fprintf ppf = kfprintf ignore ppf;;
-let ifprintf ppf = ikfprintf ignore ppf;;
-let printf fmt = fprintf std_formatter fmt;;
-let eprintf fmt = fprintf err_formatter fmt;;
-
-let ksprintf k =
+let kfprintf k o (Format (fmt, _)) =
+  make_printf (fun o acc -> output_acc o acc; k o) o End_of_acc fmt
+let ikfprintf k x (Format (fmt, _)) =
+  make_printf (fun _ _ -> k x) x End_of_acc fmt
+
+let fprintf ppf fmt = kfprintf ignore ppf fmt
+let ifprintf ppf fmt = ikfprintf ignore ppf fmt
+let printf fmt = fprintf std_formatter fmt
+let eprintf fmt = fprintf err_formatter fmt
+
+let ksprintf k (Format (fmt, _)) =
+  let k' () acc =
+    let b = Buffer.create 512 in
+    let ppf = formatter_of_buffer b in
+    strput_acc ppf acc;
+    pp_flush_queue ppf false;
+    k (Buffer.contents b) in
+  make_printf k' () End_of_acc fmt
+
+let sprintf fmt =
+  ksprintf (fun s -> s) fmt
+
+let asprintf (Format (fmt, _)) =
   let b = Buffer.create 512 in
-  let k ppf = k (string_out b ppf) in
-  let ppf = formatter_of_buffer b in
-  let get_out _ = ppf in
-  mkprintf true get_out k
-;;
-
-let sprintf fmt = ksprintf (fun s -> s) fmt;;
-
-let asprintf fmt =
-  let b = Buffer.create 512 in
-  let k ppf = string_out b ppf in
-  let ppf = formatter_of_buffer b in
-  let get_out _ = ppf in
-  mkprintf false get_out k fmt;;
+  let ppf = formatter_of_buffer b in  
+  let k' : (formatter -> (formatter, unit) acc -> string)
+    = fun ppf acc ->
+      output_acc ppf acc;
+      pp_flush_queue ppf false;
+      Buffer.contents b in
+  make_printf k' ppf End_of_acc fmt
 
 (**************************************************************
 
@@ -1412,15 +1195,10 @@ let asprintf fmt =
 
  **************************************************************)
 
-let kbprintf k b =
-  mkprintf false (fun _ -> formatter_of_buffer b) k
-;;
-
 (* Deprecated error prone function bprintf. *)
-let bprintf b =
-  let k ppf = pp_flush_queue ppf false in
-  kbprintf k b
-;;
+let bprintf b (Format (fmt, _) : ('a, formatter, unit) format) =
+  let k ppf acc = output_acc ppf acc; pp_flush_queue ppf false in
+  make_printf k (formatter_of_buffer b) End_of_acc fmt
 
 (* Deprecated alias for ksprintf. *)
 let kprintf = ksprintf;;
diff --git a/stdlib/gc.mli b/stdlib/gc.mli
index d2f2d97611..c4ed399300 100644
--- a/stdlib/gc.mli
+++ b/stdlib/gc.mli
@@ -249,7 +249,7 @@ val finalise : ('a -> unit) -> 'a -> unit
    another copy is still in use by the program.
 
 
-   The results of calling {!String.make}, {!String.create},
+   The results of calling {!String.make}, {!Bytes.make}, {!Bytes.create},
    {!Array.make}, and {!Pervasives.ref} are guaranteed to be
    heap-allocated and non-constant except when the length argument is [0].
 *)
diff --git a/stdlib/genlex.ml b/stdlib/genlex.ml
index dc80727df2..4f52b18654 100644
--- a/stdlib/genlex.ml
+++ b/stdlib/genlex.ml
@@ -21,7 +21,7 @@ type token =
 
 (* The string buffering machinery *)
 
-let initial_buffer = String.create 32
+let initial_buffer = Bytes.create 32
 
 let buffer = ref initial_buffer
 let bufpos = ref 0
@@ -29,16 +29,16 @@ let bufpos = ref 0
 let reset_buffer () = buffer := initial_buffer; bufpos := 0
 
 let store c =
-  if !bufpos >= String.length !buffer then
-    begin
-      let newbuffer = String.create (2 * !bufpos) in
-      String.blit !buffer 0 newbuffer 0 !bufpos; buffer := newbuffer
-    end;
-  String.set !buffer !bufpos c;
+  if !bufpos >= Bytes.length !buffer then begin
+    let newbuffer = Bytes.create (2 * !bufpos) in
+    Bytes.blit !buffer 0 newbuffer 0 !bufpos;
+    buffer := newbuffer
+  end;
+  Bytes.set !buffer !bufpos c;
   incr bufpos
 
 let get_string () =
-  let s = String.sub !buffer 0 !bufpos in buffer := initial_buffer; s
+  let s = Bytes.sub_string !buffer 0 !bufpos in buffer := initial_buffer; s
 
 (* The lexer *)
 
diff --git a/stdlib/lexing.ml b/stdlib/lexing.ml
index 53748ad867..d2231fbe9b 100644
--- a/stdlib/lexing.ml
+++ b/stdlib/lexing.ml
@@ -29,7 +29,7 @@ let dummy_pos = {
 
 type lexbuf =
   { refill_buff : lexbuf -> unit;
-    mutable lex_buffer : string;
+    mutable lex_buffer : bytes;
     mutable lex_buffer_len : int;
     mutable lex_abs_pos : int;
     mutable lex_start_pos : int;
@@ -81,7 +81,7 @@ let new_engine tbl state buf =
 
 let lex_refill read_fun aux_buffer lexbuf =
   let read =
-    read_fun aux_buffer (String.length aux_buffer) in
+    read_fun aux_buffer (Bytes.length aux_buffer) in
   let n =
     if read > 0
     then read
@@ -90,16 +90,16 @@ let lex_refill read_fun aux_buffer lexbuf =
         <-------|---------------------|----------->
         |  junk |      valid data     |   junk    |
         ^       ^                     ^           ^
-        0    start_pos             buffer_end    String.length buffer
+        0    start_pos             buffer_end    Bytes.length buffer
   *)
-  if lexbuf.lex_buffer_len + n > String.length lexbuf.lex_buffer then begin
+  if lexbuf.lex_buffer_len + n > Bytes.length lexbuf.lex_buffer then begin
     (* There is not enough space at the end of the buffer *)
     if lexbuf.lex_buffer_len - lexbuf.lex_start_pos + n
-       <= String.length lexbuf.lex_buffer
+       <= Bytes.length lexbuf.lex_buffer
     then begin
       (* But there is enough space if we reclaim the junk at the beginning
          of the buffer *)
-      String.blit lexbuf.lex_buffer lexbuf.lex_start_pos
+      Bytes.blit lexbuf.lex_buffer lexbuf.lex_start_pos
                   lexbuf.lex_buffer 0
                   (lexbuf.lex_buffer_len - lexbuf.lex_start_pos)
     end else begin
@@ -107,12 +107,12 @@ let lex_refill read_fun aux_buffer lexbuf =
          space since n <= String.length aux_buffer <= String.length buffer.
          Watch out for string length overflow, though. *)
       let newlen =
-        min (2 * String.length lexbuf.lex_buffer) Sys.max_string_length in
+        min (2 * Bytes.length lexbuf.lex_buffer) Sys.max_string_length in
       if lexbuf.lex_buffer_len - lexbuf.lex_start_pos + n > newlen
       then failwith "Lexing.lex_refill: cannot grow buffer";
-      let newbuf = String.create newlen in
+      let newbuf = Bytes.create newlen in
       (* Copy the valid data to the beginning of the new buffer *)
-      String.blit lexbuf.lex_buffer lexbuf.lex_start_pos
+      Bytes.blit lexbuf.lex_buffer lexbuf.lex_start_pos
                   newbuf 0
                   (lexbuf.lex_buffer_len - lexbuf.lex_start_pos);
       lexbuf.lex_buffer <- newbuf
@@ -133,9 +133,7 @@ let lex_refill read_fun aux_buffer lexbuf =
     done
   end;
   (* There is now enough space at the end of the buffer *)
-  String.blit aux_buffer 0
-              lexbuf.lex_buffer lexbuf.lex_buffer_len
-              n;
+  Bytes.blit aux_buffer 0 lexbuf.lex_buffer lexbuf.lex_buffer_len n;
   lexbuf.lex_buffer_len <- lexbuf.lex_buffer_len + n
 
 let zero_pos = {
@@ -146,8 +144,8 @@ let zero_pos = {
 };;
 
 let from_function f =
-  { refill_buff = lex_refill f (String.create 512);
-    lex_buffer = String.create 1024;
+  { refill_buff = lex_refill f (Bytes.create 512);
+    lex_buffer = Bytes.create 1024;
     lex_buffer_len = 0;
     lex_abs_pos = 0;
     lex_start_pos = 0;
@@ -165,7 +163,8 @@ let from_channel ic =
 
 let from_string s =
   { refill_buff = (fun lexbuf -> lexbuf.lex_eof_reached <- true);
-    lex_buffer = s ^ "";
+    lex_buffer = Bytes.of_string s; (* have to make a copy for compatibility
+                                       with unsafe-string mode *)
     lex_buffer_len = String.length s;
     lex_abs_pos = 0;
     lex_start_pos = 0;
@@ -180,37 +179,31 @@ let from_string s =
 
 let lexeme lexbuf =
   let len = lexbuf.lex_curr_pos - lexbuf.lex_start_pos in
-  let s = String.create len in
-  String.unsafe_blit lexbuf.lex_buffer lexbuf.lex_start_pos s 0 len;
-  s
+  Bytes.sub_string lexbuf.lex_buffer lexbuf.lex_start_pos len
 
 let sub_lexeme lexbuf i1 i2 =
   let len = i2-i1 in
-  let s = String.create len in
-  String.unsafe_blit lexbuf.lex_buffer i1 s 0 len;
-  s
+  Bytes.sub_string lexbuf.lex_buffer i1 len
 
 let sub_lexeme_opt lexbuf i1 i2 =
   if i1 >= 0 then begin
     let len = i2-i1 in
-    let s = String.create len in
-    String.unsafe_blit lexbuf.lex_buffer i1 s 0 len;
-    Some s
+    Some (Bytes.sub_string lexbuf.lex_buffer i1 len)
   end else begin
     None
   end
 
-let sub_lexeme_char lexbuf i = lexbuf.lex_buffer.[i]
+let sub_lexeme_char lexbuf i = Bytes.get lexbuf.lex_buffer i
 
 let sub_lexeme_char_opt lexbuf i =
   if i >= 0 then
-    Some lexbuf.lex_buffer.[i]
+    Some (Bytes.get lexbuf.lex_buffer i)
   else
     None
 
 
 let lexeme_char lexbuf i =
-  String.get lexbuf.lex_buffer (lexbuf.lex_start_pos + i)
+  Bytes.get lexbuf.lex_buffer (lexbuf.lex_start_pos + i)
 
 let lexeme_start lexbuf = lexbuf.lex_start_p.pos_cnum;;
 let lexeme_end lexbuf = lexbuf.lex_curr_p.pos_cnum;;
diff --git a/stdlib/lexing.mli b/stdlib/lexing.mli
index 6d5406d693..30898670b7 100644
--- a/stdlib/lexing.mli
+++ b/stdlib/lexing.mli
@@ -46,7 +46,7 @@ val dummy_pos : position;;
 
 type lexbuf =
   { refill_buff : lexbuf -> unit;
-    mutable lex_buffer : string;
+    mutable lex_buffer : bytes;
     mutable lex_buffer_len : int;
     mutable lex_abs_pos : int;
     mutable lex_start_pos : int;
@@ -84,12 +84,12 @@ val from_string : string -> lexbuf
    the string. An end-of-input condition is generated when the
    end of the string is reached. *)
 
-val from_function : (string -> int -> int) -> lexbuf
+val from_function : (bytes -> int -> int) -> lexbuf
 (** Create a lexer buffer with the given function as its reading method.
    When the scanner needs more characters, it will call the given
-   function, giving it a character string [s] and a character
-   count [n]. The function should put [n] characters or less in [s],
-   starting at character number 0, and return the number of characters
+   function, giving it a byte sequence [s] and a byte
+   count [n]. The function should put [n] bytes or fewer in [s],
+   starting at index 0, and return the number of bytes
    provided. A return value of 0 means end of input. *)
 
 
diff --git a/stdlib/map.mli b/stdlib/map.mli
index 6dd371b52c..abf4531618 100644
--- a/stdlib/map.mli
+++ b/stdlib/map.mli
@@ -19,6 +19,26 @@
    All operations over maps are purely applicative (no side-effects).
    The implementation uses balanced binary trees, and therefore searching
    and insertion take time logarithmic in the size of the map.
+
+   For instance:
+   {[
+     module IntPairs =
+       struct
+         type t = int * int
+         let compare (x0,y0) (x1,y1) =
+           match Pervasives.compare x0 x1 with
+               0 -> Pervasives.compare y0 y1
+             | c -> c
+       end
+
+     module PairsMap = Map.Make(IntPairs)
+
+     let m = PairsMap.(empty |> add (0,1) "hello" |> add (1,0) "world")
+   ]}
+
+   This creates a new module [PairsMap], with a new type ['a PairsMap.t]
+   of maps from [int * int] to ['a]. In this example, [m] contains [string]
+   values so its type is [string PairsMap.t].
 *)
 
 module type OrderedType =
diff --git a/stdlib/marshal.ml b/stdlib/marshal.ml
index 7a65a16a37..4f59a3ef21 100644
--- a/stdlib/marshal.ml
+++ b/stdlib/marshal.ml
@@ -19,35 +19,39 @@ type extern_flags =
 
 external to_channel: out_channel -> 'a -> extern_flags list -> unit
     = "caml_output_value"
+external to_bytes: 'a -> extern_flags list -> bytes
+    = "caml_output_value_to_string"
 external to_string: 'a -> extern_flags list -> string
     = "caml_output_value_to_string"
 external to_buffer_unsafe:
-      string -> int -> int -> 'a -> extern_flags list -> int
+      bytes -> int -> int -> 'a -> extern_flags list -> int
     = "caml_output_value_to_buffer"
 
 let to_buffer buff ofs len v flags =
-  if ofs < 0 || len < 0 || ofs > String.length buff - len
+  if ofs < 0 || len < 0 || ofs > Bytes.length buff - len
   then invalid_arg "Marshal.to_buffer: substring out of bounds"
   else to_buffer_unsafe buff ofs len v flags
 
 external from_channel: in_channel -> 'a = "caml_input_value"
-external from_string_unsafe: string -> int -> 'a
+external from_bytes_unsafe: bytes -> int -> 'a
                            = "caml_input_value_from_string"
-external data_size_unsafe: string -> int -> int = "caml_marshal_data_size"
+external data_size_unsafe: bytes -> int -> int = "caml_marshal_data_size"
 
 let header_size = 20
 let data_size buff ofs =
-  if ofs < 0 || ofs > String.length buff - header_size
+  if ofs < 0 || ofs > Bytes.length buff - header_size
   then invalid_arg "Marshal.data_size"
   else data_size_unsafe buff ofs
 let total_size buff ofs = header_size + data_size buff ofs
 
-let from_string buff ofs =
-  if ofs < 0 || ofs > String.length buff - header_size
-  then invalid_arg "Marshal.from_size"
+let from_bytes buff ofs =
+  if ofs < 0 || ofs > Bytes.length buff - header_size
+  then invalid_arg "Marshal.from_bytes"
   else begin
     let len = data_size_unsafe buff ofs in
-    if ofs > String.length buff - (header_size + len)
-    then invalid_arg "Marshal.from_string"
-    else from_string_unsafe buff ofs
+    if ofs > Bytes.length buff - (header_size + len)
+    then invalid_arg "Marshal.from_bytes"
+    else from_bytes_unsafe buff ofs
   end
+
+let from_string buff ofs = from_bytes (Bytes.unsafe_of_string buff) ofs
diff --git a/stdlib/marshal.mli b/stdlib/marshal.mli
index f12af9fd9d..37f0345b38 100644
--- a/stdlib/marshal.mli
+++ b/stdlib/marshal.mli
@@ -33,12 +33,13 @@
    Anything can happen at run-time if the object in the file does not
    belong to the given type.
 
-   OCaml exception values (of type [exn]) returned by the unmarhsaller
-   should not be pattern-matched over through [match ... with] or [try
-   ... with], because unmarshalling does not preserve the information
-   required for matching their exception constructor. Structural
-   equalities with other exception values, or most other uses such as
-   Printexc.to_string, will still work as expected.
+   Values of extensible variant types, for example exceptions (of
+   extensible type [exn]), returned by the unmarhsaller should not be
+   pattern-matched over through [match ... with] or [try ... with],
+   because unmarshalling does not preserve the information required for
+   matching their constructors. Structural equalities with other
+   extensible variant values does not work either.  Most other uses such
+   as Printexc.to_string, will still work as expected.
 
    The representation of marshaled values is not human-readable,
    and uses bytes that are not printable characters. Therefore,
@@ -47,7 +48,7 @@
    [open_out_bin] or [open_in_bin]; channels opened in text mode will
    cause unmarshaling errors on platforms where text channels behave
    differently than binary channels, e.g. Windows.
-*)
+ *)
 
 type extern_flags =
     No_sharing                          (** Don't preserve sharing *)
@@ -74,17 +75,26 @@ val to_channel : out_channel -> 'a -> extern_flags list -> unit
    byte representations if [v] actually contains sharing,
    or even non-termination if [v] contains cycles.
 
-   If [flags] does not contain [Marshal.Closures],
-   marshaling fails when it encounters a functional value
-   inside [v]: only 'pure' data structures, containing neither
-   functions nor objects, can safely be transmitted between
-   different programs. If [flags] contains [Marshal.Closures],
-   functional values will be marshaled as a position in the code
-   of the program. In this case, the output of marshaling can
-   only be read back in processes that run exactly the same program,
-   with exactly the same compiled code. (This is checked
-   at un-marshaling time, using an MD5 digest of the code
-   transmitted along with the code position.)
+   If [flags] does not contain [Marshal.Closures], marshaling fails
+   when it encounters a functional value inside [v]: only 'pure' data
+   structures, containing neither functions nor objects, can safely be
+   transmitted between different programs. If [flags] contains
+   [Marshal.Closures], functional values will be marshaled as a the
+   position in the code of the program together with the values
+   corresponding to the free variables captured in the closure.  In
+   this case, the output of marshaling can only be read back in
+   processes that run exactly the same program, with exactly the same
+   compiled code. (This is checked at un-marshaling time, using an MD5
+   digest of the code transmitted along with the code position.)
+
+   The exact definition of which free variables are captured in a
+   closure is not specified and can very between bytecode and native
+   code (and according to optimization flags).  In particular, a
+   function value accessing a global reference may or may not include
+   the reference in its closure.  If it does, unmarshaling the
+   corresponding closure will create a new reference, different from
+   the global one.
+
 
    If [flags] contains [Marshal.Compat_32], marshaling fails when
    it encounters an integer value outside the range [[-2{^30}, 2{^30}-1]]
@@ -99,19 +109,24 @@ val to_channel : out_channel -> 'a -> extern_flags list -> unit
    it has no effect if marshaling is performed on a 32-bit platform.
  *)
 
-external to_string :
-  'a -> extern_flags list -> string = "caml_output_value_to_string"
-(** [Marshal.to_string v flags] returns a string containing
-   the representation of [v] as a sequence of bytes.
+external to_bytes :
+  'a -> extern_flags list -> bytes = "caml_output_value_to_string"
+(** [Marshal.to_bytes v flags] returns a byte sequence containing
+   the representation of [v].
    The [flags] argument has the same meaning as for
    {!Marshal.to_channel}. *)
 
-val to_buffer : string -> int -> int -> 'a -> extern_flags list -> int
+external to_string :
+  'a -> extern_flags list -> string = "caml_output_value_to_string"
+(** Same as [to_bytes] but return the result as a string instead of
+    a byte sequence. *)
+
+val to_buffer : bytes -> int -> int -> 'a -> extern_flags list -> int
 (** [Marshal.to_buffer buff ofs len v flags] marshals the value [v],
-   storing its byte representation in the string [buff],
-   starting at character number [ofs], and writing at most
-   [len] characters.  It returns the number of characters
-   actually written to the string. If the byte representation
+   storing its byte representation in the sequence [buff],
+   starting at index [ofs], and writing at most
+   [len] bytes.  It returns the number of bytes
+   actually written to the sequence. If the byte representation
    of [v] does not fit in [len] characters, the exception [Failure]
    is raised. *)
 
@@ -121,36 +136,40 @@ val from_channel : in_channel -> 'a
    one of the [Marshal.to_*] functions, and reconstructs and
    returns the corresponding value.*)
 
-val from_string : string -> int -> 'a
-(** [Marshal.from_string buff ofs] unmarshals a structured value
+val from_bytes : bytes -> int -> 'a
+(** [Marshal.from_bytes buff ofs] unmarshals a structured value
    like {!Marshal.from_channel} does, except that the byte
    representation is not read from a channel, but taken from
-   the string [buff], starting at position [ofs]. *)
+   the byte sequence [buff], starting at position [ofs]. *)
+
+val from_string : string -> int -> 'a
+(** Same as [from_bytes] but take a string as argument instead of a
+    byte sequence. *)
 
 val header_size : int
 (** The bytes representing a marshaled value are composed of
    a fixed-size header and a variable-sized data part,
    whose size can be determined from the header.
-   {!Marshal.header_size} is the size, in characters, of the header.
-   {!Marshal.data_size}[ buff ofs] is the size, in characters,
+   {!Marshal.header_size} is the size, in bytes, of the header.
+   {!Marshal.data_size}[ buff ofs] is the size, in bytes,
    of the data part, assuming a valid header is stored in
    [buff] starting at position [ofs].
    Finally, {!Marshal.total_size} [buff ofs] is the total size,
-   in characters, of the marshaled value.
+   in bytes, of the marshaled value.
    Both {!Marshal.data_size} and {!Marshal.total_size} raise [Failure]
    if [buff], [ofs] does not contain a valid header.
 
    To read the byte representation of a marshaled value into
-   a string buffer, the program needs to read first
-   {!Marshal.header_size} characters into the buffer,
+   a byte sequence, the program needs to read first
+   {!Marshal.header_size} bytes into the sequence,
    then determine the length of the remainder of the
    representation using {!Marshal.data_size},
-   make sure the buffer is large enough to hold the remaining
-   data, then read it, and finally call {!Marshal.from_string}
+   make sure the sequence is large enough to hold the remaining
+   data, then read it, and finally call {!Marshal.from_bytes}
    to unmarshal the value. *)
 
-val data_size : string -> int -> int
+val data_size : bytes -> int -> int
 (** See {!Marshal.header_size}.*)
 
-val total_size : string -> int -> int
+val total_size : bytes -> int -> int
 (** See {!Marshal.header_size}.*)
diff --git a/stdlib/obj.ml b/stdlib/obj.ml
index a6f11586e8..d054d35c42 100644
--- a/stdlib/obj.ml
+++ b/stdlib/obj.ml
@@ -33,9 +33,9 @@ external truncate : t -> int -> unit = "caml_obj_truncate"
 external add_offset : t -> Int32.t -> t = "caml_obj_add_offset"
 
 let marshal (obj : t) =
-  Marshal.to_string obj []
+  Marshal.to_bytes obj []
 let unmarshal str pos =
-  (Marshal.from_string str pos, pos + Marshal.total_size str pos)
+  (Marshal.from_bytes str pos, pos + Marshal.total_size str pos)
 
 let lazy_tag = 246
 let closure_tag = 247
@@ -56,3 +56,28 @@ let final_tag = custom_tag
 let int_tag = 1000
 let out_of_heap_tag = 1001
 let unaligned_tag = 1002
+
+let extension_slot x =
+  let x = repr x in
+  let slot =
+    if (is_block x) && (tag x) <> object_tag && (size x) >= 1 then field x 0
+    else x
+  in
+  let name =
+    if (is_block slot) && (tag slot) = object_tag then field slot 0
+    else raise Not_found
+  in
+    if (tag name) = string_tag then slot
+    else raise Not_found
+
+let extension_name x =
+  try
+    let slot = extension_slot x in
+      (obj (field slot 0) : string)
+  with Not_found -> invalid_arg "Obj.extension_name"
+
+let extension_id x =
+  try
+    let slot = extension_slot x in
+      (obj (field slot 1) : int)
+  with Not_found -> invalid_arg "Obj.extension_id"
diff --git a/stdlib/obj.mli b/stdlib/obj.mli
index 9a5bd721d5..5181e2a22b 100644
--- a/stdlib/obj.mli
+++ b/stdlib/obj.mli
@@ -43,18 +43,21 @@ val infix_tag : int
 val forward_tag : int
 val no_scan_tag : int
 val abstract_tag : int
-val string_tag : int
+val string_tag : int   (* both [string] and [bytes] *)
 val double_tag : int
 val double_array_tag : int
 val custom_tag : int
-val final_tag : int  (* DEPRECATED *)
+val final_tag : int [@@ocaml.deprecated]
 
 val int_tag : int
 val out_of_heap_tag : int
 val unaligned_tag : int   (* should never happen @since 3.11.0 *)
 
+val extension_name : 'a -> string
+val extension_id : 'a -> int
+
 (** The following two functions are deprecated.  Use module {!Marshal}
     instead. *)
 
-val marshal : t -> string
-val unmarshal : string -> int -> t * int
+val marshal : t -> bytes [@@ocaml.deprecated]
+val unmarshal : bytes -> int -> t * int [@@ocaml.deprecated]
diff --git a/stdlib/pervasives.ml b/stdlib/pervasives.ml
index 9f88480bfa..8f9e423f95 100644
--- a/stdlib/pervasives.ml
+++ b/stdlib/pervasives.ml
@@ -46,9 +46,7 @@ external __MODULE__ : string = "%loc_MODULE"
 external __POS__ : string * int * int * int = "%loc_POS"
 
 external __LOC_OF__ : 'a -> string * 'a = "%loc_LOC"
-external __FILE_OF__ : 'a -> string * 'a = "%loc_FILE"
 external __LINE_OF__ : 'a -> int * 'a = "%loc_LINE"
-external __MODULE_OF__ : 'a -> string * 'a = "%loc_MODULE"
 external __POS_OF__ : 'a -> (string * int * int * int) * 'a = "%loc_POS"
 
 (* Comparisons *)
@@ -83,7 +81,7 @@ external succ : int -> int = "%succint"
 external pred : int -> int = "%predint"
 external ( + ) : int -> int -> int = "%addint"
 external ( - ) : int -> int -> int = "%subint"
-external ( *  ) : int -> int -> int = "%mulint"
+external ( * ) : int -> int -> int = "%mulint"
 external ( / ) : int -> int -> int = "%divint"
 external ( mod ) : int -> int -> int = "%modint"
 
@@ -164,19 +162,24 @@ type fpclass =
   | FP_nan
 external classify_float : float -> fpclass = "caml_classify_float"
 
-(* String operations -- more in module String *)
+(* String and byte sequence operations -- more in modules String and Bytes *)
 
 external string_length : string -> int = "%string_length"
-external string_create : int -> string = "caml_create_string"
-external string_blit : string -> int -> string -> int -> int -> unit
+external bytes_length : bytes -> int = "%string_length"
+external bytes_create : int -> bytes = "caml_create_string"
+external string_blit : string -> int -> bytes -> int -> int -> unit
                      = "caml_blit_string" "noalloc"
+external bytes_blit : bytes -> int -> bytes -> int -> int -> unit
+                        = "caml_blit_string" "noalloc"
+external bytes_unsafe_to_string : bytes -> string = "%identity"
+external bytes_unsafe_of_string : string -> bytes = "%identity"
 
 let ( ^ ) s1 s2 =
   let l1 = string_length s1 and l2 = string_length s2 in
-  let s = string_create (l1 + l2) in
+  let s = bytes_create (l1 + l2) in
   string_blit s1 0 s 0 l1;
   string_blit s2 0 s l1 l2;
-  s
+  bytes_unsafe_to_string s
 
 (* Character operations -- more in module Char *)
 
@@ -219,16 +222,13 @@ let string_of_int n =
   format_int "%d" n
 
 external int_of_string : string -> int = "caml_int_of_string"
-
-module String = struct
-  external get : string -> int -> char = "%string_safe_get"
-end
+external string_get : string -> int -> char = "%string_safe_get"
 
 let valid_float_lexem s =
   let l = string_length s in
   let rec loop i =
     if i >= l then s ^ "." else
-    match s.[i] with
+    match string_get s i with
     | '0' .. '9' | '-' -> loop (i + 1)
     | _ -> s
   in
@@ -288,19 +288,25 @@ let flush_all () =
     | a :: l -> (try flush a with _ -> ()); iter l
   in iter (out_channels_list ())
 
-external unsafe_output : out_channel -> string -> int -> int -> unit
+external unsafe_output : out_channel -> bytes -> int -> int -> unit
                        = "caml_ml_output"
 
 external output_char : out_channel -> char -> unit = "caml_ml_output_char"
 
+let output_bytes oc s =
+  unsafe_output oc s 0 (bytes_length s)
+
 let output_string oc s =
-  unsafe_output oc s 0 (string_length s)
+  unsafe_output oc (bytes_unsafe_of_string s) 0 (string_length s)
 
 let output oc s ofs len =
-  if ofs < 0 || len < 0 || ofs > string_length s - len
+  if ofs < 0 || len < 0 || ofs > bytes_length s - len
   then invalid_arg "output"
   else unsafe_output oc s ofs len
 
+let output_substring oc s ofs len =
+  output oc (bytes_unsafe_of_string s) ofs len
+
 external output_byte : out_channel -> int -> unit = "caml_ml_output_char"
 external output_binary_int : out_channel -> int -> unit = "caml_ml_output_int"
 
@@ -332,11 +338,11 @@ let open_in_bin name =
 
 external input_char : in_channel -> char = "caml_ml_input_char"
 
-external unsafe_input : in_channel -> string -> int -> int -> int
+external unsafe_input : in_channel -> bytes -> int -> int -> int
                       = "caml_ml_input"
 
 let input ic s ofs len =
-  if ofs < 0 || len < 0 || ofs > string_length s - len
+  if ofs < 0 || len < 0 || ofs > bytes_length s - len
   then invalid_arg "input"
   else unsafe_input ic s ofs len
 
@@ -349,39 +355,44 @@ let rec unsafe_really_input ic s ofs len =
   end
 
 let really_input ic s ofs len =
-  if ofs < 0 || len < 0 || ofs > string_length s - len
+  if ofs < 0 || len < 0 || ofs > bytes_length s - len
   then invalid_arg "really_input"
   else unsafe_really_input ic s ofs len
 
+let really_input_string ic len =
+  let s = bytes_create len in
+  really_input ic s 0 len;
+  bytes_unsafe_to_string s
+
 external input_scan_line : in_channel -> int = "caml_ml_input_scan_line"
 
 let input_line chan =
   let rec build_result buf pos = function
     [] -> buf
   | hd :: tl ->
-      let len = string_length hd in
-      string_blit hd 0 buf (pos - len) len;
+      let len = bytes_length hd in
+      bytes_blit hd 0 buf (pos - len) len;
       build_result buf (pos - len) tl in
   let rec scan accu len =
     let n = input_scan_line chan in
     if n = 0 then begin                   (* n = 0: we are at EOF *)
       match accu with
         [] -> raise End_of_file
-      | _  -> build_result (string_create len) len accu
+      | _  -> build_result (bytes_create len) len accu
     end else if n > 0 then begin          (* n > 0: newline found in buffer *)
-      let res = string_create (n - 1) in
+      let res = bytes_create (n - 1) in
       ignore (unsafe_input chan res 0 (n - 1));
       ignore (input_char chan);           (* skip the newline *)
       match accu with
         [] -> res
       |  _ -> let len = len + n - 1 in
-              build_result (string_create len) len (res :: accu)
+              build_result (bytes_create len) len (res :: accu)
     end else begin                        (* n < 0: newline not found *)
-      let beg = string_create (-n) in
+      let beg = bytes_create (-n) in
       ignore(unsafe_input chan beg 0 (-n));
       scan (beg :: accu) (len - n)
     end
-  in scan [] 0
+  in bytes_unsafe_to_string (scan [] 0)
 
 external input_byte : in_channel -> int = "caml_ml_input_char"
 external input_binary_int : in_channel -> int = "caml_ml_input_int"
@@ -398,6 +409,7 @@ external set_binary_mode_in : in_channel -> bool -> unit
 
 let print_char c = output_char stdout c
 let print_string s = output_string stdout s
+let print_bytes s = output_bytes stdout s
 let print_int i = output_string stdout (string_of_int i)
 let print_float f = output_string stdout (string_of_float f)
 let print_endline s =
@@ -408,6 +420,7 @@ let print_newline () = output_char stdout '\n'; flush stdout
 
 let prerr_char c = output_char stderr c
 let prerr_string s = output_string stderr s
+let prerr_bytes s = output_bytes stderr s
 let prerr_int i = output_string stderr (string_of_int i)
 let prerr_float f = output_string stderr (string_of_float f)
 let prerr_endline s =
@@ -434,33 +447,25 @@ module LargeFile =
   end
 
 (* Formats *)
+
+type ('a, 'b, 'c, 'd, 'e, 'f) format6
+   = ('a, 'b, 'c, 'd, 'e, 'f) CamlinternalFormatBasics.format6
+   = Format of ('a, 'b, 'c, 'd, 'e, 'f) CamlinternalFormatBasics.fmt
+               * string
+
 type ('a, 'b, 'c, 'd) format4 = ('a, 'b, 'c, 'c, 'c, 'd) format6
 
 type ('a, 'b, 'c) format = ('a, 'b, 'c, 'c) format4
 
+let string_of_format (Format (fmt, str)) = str
+
 external format_of_string :
  ('a, 'b, 'c, 'd, 'e, 'f) format6 ->
  ('a, 'b, 'c, 'd, 'e, 'f) format6 = "%identity"
 
-external format_to_string :
- ('a, 'b, 'c, 'd, 'e, 'f) format6 -> string = "%identity"
-external string_to_format :
- string -> ('a, 'b, 'c, 'd, 'e, 'f) format6 = "%identity"
-
-let (( ^^ ) :
-      ('a, 'b, 'c, 'd, 'e, 'f) format6 ->
-      ('f, 'b, 'c, 'e, 'g, 'h) format6 ->
-      ('a, 'b, 'c, 'd, 'g, 'h) format6) =
-  fun fmt1 fmt2 ->
-    string_to_format (format_to_string fmt1 ^ "%," ^ format_to_string fmt2)
-;;
-
-let string_of_format fmt =
-  let s = format_to_string fmt in
-  let l = string_length s in
-  let r = string_create l in
-  string_blit s 0 r 0 l;
-  r
+let (^^) (Format (fmt1, str1)) (Format (fmt2, str2)) =
+  Format (CamlinternalFormatBasics.concat_fmt fmt1 fmt2,
+          str1 ^ "%," ^ str2)
 
 (* Miscellaneous *)
 
diff --git a/stdlib/pervasives.mli b/stdlib/pervasives.mli
index 1ee09984c7..77cb1e92ce 100644
--- a/stdlib/pervasives.mli
+++ b/stdlib/pervasives.mli
@@ -14,8 +14,8 @@
 (** The initially opened module.
 
    This module provides the basic operations over the built-in types
-   (numbers, booleans, strings, exceptions, references, lists, arrays,
-   input-output channels, ...).
+   (numbers, booleans, byte sequences, strings, exceptions, references,
+   lists, arrays, input-output channels, ...).
 
    This module is automatically opened at the beginning of each compilation.
    All components of this module can therefore be referred by their short
@@ -68,7 +68,7 @@ external ( <= ) : 'a -> 'a -> bool = "%lessequal"
 
 external ( >= ) : 'a -> 'a -> bool = "%greaterequal"
 (** Structural ordering functions. These functions coincide with
-   the usual orderings over integers, characters, strings
+   the usual orderings over integers, characters, strings, byte sequences
    and floating-point numbers, and extend them to a
    total ordering over all types.
    The ordering is compatible with [( = )]. As in the case
@@ -107,7 +107,7 @@ val max : 'a -> 'a -> 'a
 
 external ( == ) : 'a -> 'a -> bool = "%eq"
 (** [e1 == e2] tests for physical equality of [e1] and [e2].
-   On mutable types such as references, arrays, strings, records with
+   On mutable types such as references, arrays, byte sequences, records with
    mutable fields and objects with mutable instance variables,
    [e1 == e2] is true if and only if physical modification of [e1]
    also affects [e2].
@@ -143,16 +143,41 @@ external ( or ) : bool -> bool -> bool = "%sequor"
 (** {6 Debugging} *)
 
 external __LOC__ : string = "%loc_LOC"
+(** [__LOC__] returns the location at which this expression appears in
+    the file currently being parsed by the compiler, with the standard
+    error format of OCaml: "File %S, line %d, characters %d-%d" *)
 external __FILE__ : string = "%loc_FILE"
+(** [__FILE__] returns the name of the file currently being
+    parsed by the compiler. *)
 external __LINE__ : int = "%loc_LINE"
+(** [__LINE__] returns the line number at which this expression
+    appears in the file currently being parsed by the compiler. *)
 external __MODULE__ : string = "%loc_MODULE"
+(** [__MODULE__] returns the module name of the file being
+    parsed by the compiler. *)
 external __POS__ : string * int * int * int = "%loc_POS"
+(** [__POS__] returns a tuple [(file,lnum,cnum,enum)], corresponding
+    to the location at which this expression appears in the file
+    currently being parsed by the compiler. [file] is the current
+    filename, [lnum] the line number, [cnum] the character position in
+    the line and [enum] the last character position in the line. *)
 
 external __LOC_OF__ : 'a -> string * 'a = "%loc_LOC"
-external __FILE_OF__ : 'a -> string * 'a = "%loc_FILE"
+(** [__LOC_OF__ expr] returns a pair [(loc, expr)] where [loc] is the
+    location of [expr] in the file currently being parsed by the
+    compiler, with the standard error format of OCaml: "File %S, line
+    %d, characters %d-%d" *)
 external __LINE_OF__ : 'a -> int * 'a = "%loc_LINE"
-external __MODULE_OF__ : 'a -> string * 'a = "%loc_MODULE"
+(** [__LINE__ expr] returns a pair [(line, expr)], where [line] is the
+    line number at which the expression [expr] appears in the file
+    currently being parsed by the compiler. *)
 external __POS_OF__ : 'a -> (string * int * int * int) * 'a = "%loc_POS"
+(** [__POS_OF__ expr] returns a pair [(expr,loc)], where [loc] is a
+    tuple [(file,lnum,cnum,enum)] corresponding to the location at
+    which the expression [expr] appears in the file currently being
+    parsed by the compiler. [file] is the current filename, [lnum] the
+    line number, [cnum] the character position in the line and [enum]
+    the last character position in the line. *)
 
 (** {6 Composition operators} *)
 
@@ -566,6 +591,9 @@ val print_char : char -> unit
 val print_string : string -> unit
 (** Print a string on standard output. *)
 
+val print_bytes : bytes -> unit
+(** Print a byte sequence on standard output. *)
+
 val print_int : int -> unit
 (** Print an integer, in decimal, on standard output. *)
 
@@ -590,6 +618,9 @@ val prerr_char : char -> unit
 val prerr_string : string -> unit
 (** Print a string on standard error. *)
 
+val prerr_bytes : bytes -> unit
+(** Print a byte sequence on standard error. *)
+
 val prerr_int : int -> unit
 (** Print an integer, in decimal, on standard error. *)
 
@@ -597,8 +628,8 @@ val prerr_float : float -> unit
 (** Print a floating-point number, in decimal, on standard error. *)
 
 val prerr_endline : string -> unit
-(** Print a string, followed by a newline character on standard error
-   and flush standard error. *)
+(** Print a string, followed by a newline character on standard
+   error and flush standard error. *)
 
 val prerr_newline : unit -> unit
 (** Print a newline character on standard error, and flush
@@ -674,11 +705,18 @@ val output_char : out_channel -> char -> unit
 val output_string : out_channel -> string -> unit
 (** Write the string on the given output channel. *)
 
-val output : out_channel -> string -> int -> int -> unit
-(** [output oc buf pos len] writes [len] characters from string [buf],
+val output_bytes : out_channel -> bytes -> unit
+(** Write the byte sequence on the given output channel. *)
+
+val output : out_channel -> bytes -> int -> int -> unit
+(** [output oc buf pos len] writes [len] characters from byte sequence [buf],
    starting at offset [pos], to the given output channel [oc].
    Raise [Invalid_argument "output"] if [pos] and [len] do not
-   designate a valid substring of [buf]. *)
+   designate a valid range of [buf]. *)
+
+val output_substring : out_channel -> string -> int -> int -> unit
+(** Same as [output] but take a string as argument instead of
+   a byte sequence. *)
 
 val output_byte : out_channel -> int -> unit
 (** Write one 8-bit integer (as the single character with that code)
@@ -769,9 +807,9 @@ val input_line : in_channel -> string
    Raise [End_of_file] if the end of the file is reached
    at the beginning of line. *)
 
-val input : in_channel -> string -> int -> int -> int
+val input : in_channel -> bytes -> int -> int -> int
 (** [input ic buf pos len] reads up to [len] characters from
-   the given channel [ic], storing them in string [buf], starting at
+   the given channel [ic], storing them in byte sequence [buf], starting at
    character number [pos].
    It returns the actual number of characters read, between 0 and
    [len] (inclusive).
@@ -784,15 +822,21 @@ val input : in_channel -> string -> int -> int -> int
    if desired.  (See also {!Pervasives.really_input} for reading
    exactly [len] characters.)
    Exception [Invalid_argument "input"] is raised if [pos] and [len]
-   do not designate a valid substring of [buf]. *)
+   do not designate a valid range of [buf]. *)
 
-val really_input : in_channel -> string -> int -> int -> unit
+val really_input : in_channel -> bytes -> int -> int -> unit
 (** [really_input ic buf pos len] reads [len] characters from channel [ic],
-   storing them in string [buf], starting at character number [pos].
+   storing them in byte sequence [buf], starting at character number [pos].
    Raise [End_of_file] if the end of file is reached before [len]
    characters have been read.
    Raise [Invalid_argument "really_input"] if
-   [pos] and [len] do not designate a valid substring of [buf]. *)
+   [pos] and [len] do not designate a valid range of [buf]. *)
+
+val really_input_string : in_channel -> int -> string
+(** [really_input_string ic len] reads [len] characters from channel [ic]
+   and returns them in a new string.
+   Raise [End_of_file] if the end of file is reached before [len]
+   characters have been read. *)
 
 val input_byte : in_channel -> int
 (** Same as {!Pervasives.input_char}, but return the 8-bit integer representing
@@ -923,7 +967,7 @@ external decr : int ref -> unit = "%decr"
 *)
 
 (** Format strings have a general and highly polymorphic type
-    [('a, 'b, 'c, 'd, 'e, 'f) format6]. Type [format6] is built in.
+    [('a, 'b, 'c, 'd, 'e, 'f) format6].
     The two simplified types, [format] and [format4] below are
     included for backward compatibility with earlier releases of
     OCaml.
@@ -962,6 +1006,10 @@ external decr : int ref -> unit = "%decr"
       for the [scanf]-style functions, it is typically the result type of the
       receiver function.
 *)
+
+type ('a, 'b, 'c, 'd, 'e, 'f) format6 =
+  ('a, 'b, 'c, 'd, 'e, 'f) CamlinternalFormatBasics.format6
+
 type ('a, 'b, 'c, 'd) format4 = ('a, 'b, 'c, 'c, 'c, 'd) format6
 
 type ('a, 'b, 'c) format = ('a, 'b, 'c, 'c) format4
@@ -1016,6 +1064,6 @@ val at_exit : (unit -> unit) -> unit
 
 val valid_float_lexem : string -> string
 
-val unsafe_really_input : in_channel -> string -> int -> int -> unit
+val unsafe_really_input : in_channel -> bytes -> int -> int -> unit
 
 val do_at_exit : unit -> unit
diff --git a/stdlib/printexc.ml b/stdlib/printexc.ml
index 285308b79d..4ebb84ceae 100644
--- a/stdlib/printexc.ml
+++ b/stdlib/printexc.ml
@@ -82,12 +82,13 @@ let catch fct arg =
     eprintf "Uncaught exception: %s\n" (to_string x);
     exit 2
 
-type raw_backtrace
+type raw_backtrace_slot
+type raw_backtrace = raw_backtrace_slot array
 
 external get_raw_backtrace:
   unit -> raw_backtrace = "caml_get_exception_raw_backtrace"
 
-type loc_info =
+type backtrace_slot =
   | Known_location of bool   (* is_raise *)
                     * string (* filename *)
                     * int    (* line number *)
@@ -98,29 +99,27 @@ type loc_info =
 (* to avoid warning *)
 let _ = [Known_location (false, "", 0, 0, 0); Unknown_location false]
 
-type backtrace = loc_info array
+external convert_raw_backtrace_slot:
+  raw_backtrace_slot -> backtrace_slot = "caml_convert_raw_backtrace_slot"
 
-external convert_raw_backtrace:
-  raw_backtrace -> backtrace option = "caml_convert_raw_backtrace"
+let convert_raw_backtrace rbckt =
+  try Some (Array.map convert_raw_backtrace_slot rbckt)
+  with Failure _ -> None
 
-let format_loc_info pos li =
-  let is_raise =
-    match li with
-    | Known_location(is_raise, _, _, _, _) -> is_raise
-    | Unknown_location(is_raise) -> is_raise in
-  let info =
+let format_backtrace_slot pos slot =
+  let info is_raise =
     if is_raise then
       if pos = 0 then "Raised at" else "Re-raised at"
     else
       if pos = 0 then "Raised by primitive operation at" else "Called from"
   in
-  match li with
+  match slot with
+  | Unknown_location true -> (* compiler-inserted re-raise, skipped *) None
+  | Unknown_location false ->
+      Some (sprintf "%s unknown location" (info false))
   | Known_location(is_raise, filename, lineno, startchar, endchar) ->
-      sprintf "%s file \"%s\", line %d, characters %d-%d"
-              info filename lineno startchar endchar
-  | Unknown_location(is_raise) ->
-      sprintf "%s unknown location"
-              info
+      Some (sprintf "%s file \"%s\", line %d, characters %d-%d"
+              (info is_raise) filename lineno startchar endchar)
 
 let print_exception_backtrace outchan backtrace =
   match backtrace with
@@ -129,8 +128,9 @@ let print_exception_backtrace outchan backtrace =
         "(Program not linked with -g, cannot print stack backtrace)\n"
   | Some a ->
       for i = 0 to Array.length a - 1 do
-        if a.(i) <> Unknown_location true then
-          fprintf outchan "%s\n" (format_loc_info i a.(i))
+        match format_backtrace_slot i a.(i) with
+          | None -> ()
+          | Some str -> fprintf outchan "%s\n" str
       done
 
 let print_raw_backtrace outchan raw_backtrace =
@@ -147,20 +147,70 @@ let backtrace_to_string backtrace =
   | Some a ->
       let b = Buffer.create 1024 in
       for i = 0 to Array.length a - 1 do
-        if a.(i) <> Unknown_location true then
-          bprintf b "%s\n" (format_loc_info i a.(i))
+        match format_backtrace_slot i a.(i) with
+          | None -> ()
+          | Some str -> bprintf b "%s\n" str
       done;
       Buffer.contents b
 
 let raw_backtrace_to_string raw_backtrace =
   backtrace_to_string (convert_raw_backtrace raw_backtrace)
 
+let backtrace_slot_is_raise = function
+  | Known_location(is_raise, _, _, _, _) -> is_raise
+  | Unknown_location(is_raise) -> is_raise
+
+type location = {
+  filename : string;
+  line_number : int;
+  start_char : int;
+  end_char : int;
+}
+
+let backtrace_slot_location = function
+  | Unknown_location _ -> None
+  | Known_location(_is_raise, filename, line_number,
+                   start_char, end_char) ->
+    Some {
+      filename;
+      line_number;
+      start_char;
+      end_char;
+    }
+
+let backtrace_slots raw_backtrace =
+  (* The documentation of this function guarantees that Some is
+     returned only if a part of the trace is usable. This gives us
+     a bit more work than just convert_raw_backtrace, but it makes the
+     API more user-friendly -- otherwise most users would have to
+     reimplement the "Program not linked with -g, sorry" logic
+     themselves. *)
+  match convert_raw_backtrace raw_backtrace with
+    | None -> None
+    | Some backtrace ->
+      let usable_slot = function
+        | Unknown_location _ -> false
+        | Known_location _ -> true in
+      let rec exists_usable = function
+        | (-1) -> false
+        | i -> usable_slot backtrace.(i) || exists_usable (i - 1) in
+      if exists_usable (Array.length backtrace - 1)
+      then Some backtrace
+      else None
+
+module Slot = struct
+  type t = backtrace_slot
+  let format = format_backtrace_slot
+  let is_raise = backtrace_slot_is_raise
+  let location = backtrace_slot_location
+end
+
+let raw_backtrace_length bckt = Array.length bckt
+let get_raw_backtrace_slot bckt i = Array.get bckt i
+
 (* confusingly named:
    returns the *string* corresponding to the global current backtrace *)
 let get_backtrace () =
-  (* we could use the caml_get_exception_backtrace primitive here, but
-     we hope to deprecate it so it's better to just compose the
-     raw stuff *)
   backtrace_to_string (convert_raw_backtrace (get_raw_backtrace ()))
 
 external record_backtrace: bool -> unit = "caml_record_backtrace"
@@ -169,10 +219,8 @@ external backtrace_status: unit -> bool = "caml_backtrace_status"
 let register_printer fn =
   printers := fn :: !printers
 
-
 external get_callstack: int -> raw_backtrace = "caml_get_current_callstack"
 
-
 let exn_slot x =
   let x = Obj.repr x in
   if Obj.tag x = 0 then Obj.field x 0 else x
diff --git a/stdlib/printexc.mli b/stdlib/printexc.mli
index 2916bf1435..6bffe174cb 100644
--- a/stdlib/printexc.mli
+++ b/stdlib/printexc.mli
@@ -86,19 +86,53 @@ val register_printer: (exn -> string option) -> unit
 (** {6 Raw backtraces} *)
 
 type raw_backtrace
-
-(** The abstract type [backtrace] stores exception backtraces in
+(** The abstract type [raw_backtrace] stores a backtrace in
     a low-level format, instead of directly exposing them as string as
     the [get_backtrace()] function does.
 
     This allows delaying the formatting of backtraces to when they are
-    actually printed, which might be useful if you record more
+    actually printed, which may be useful if you record more
     backtraces than you print.
+
+    Raw backtraces cannot be marshalled. If you need marshalling, you
+    should use the array returned by the [backtrace_slots] function of
+    the next section.
+
+    @since 4.01.0
 *)
 
 val get_raw_backtrace: unit -> raw_backtrace
+(** [Printexc.get_raw_backtrace ()] returns the same exception
+    backtrace that [Printexc.print_backtrace] would print, but in
+    a raw format.
+
+    @since 4.01.0
+*)
+
 val print_raw_backtrace: out_channel -> raw_backtrace -> unit
+(** Print a raw backtrace in the same format
+    [Printexc.print_backtrace] uses.
+
+    @since 4.01.0
+*)
+
 val raw_backtrace_to_string: raw_backtrace -> string
+(** Return a string from a raw backtrace, in the same format
+    [Printexc.get_backtrace] uses.
+
+    @since 4.01.0
+*)
+
+(** {6 Current call stack} *)
+
+val get_callstack: int -> raw_backtrace
+(** [Printexc.get_callstack n] returns a description of the top of the
+    call stack on the current program point (for the current thread),
+    with at most [n] entries.  (Note: this function is not related to
+    exceptions at all, despite being part of the [Printexc] module.)
+
+    @since 4.01.0
+*)
 
 (** {6 Uncaught exceptions} *)
 
@@ -116,16 +150,120 @@ val set_uncaught_exception_handler: (exn -> raw_backtrace -> unit) -> unit
     @since 4.02.0
 *)
 
-(** {6 Current call stack} *)
 
-val get_callstack: int -> raw_backtrace
+(** {6 Manipulation of backtrace information}
 
-(** [Printexc.get_callstack n] returns a description of the top of the
-    call stack on the current program point (for the current thread),
-    with at most [n] entries.  (Note: this function is not related to
-    exceptions at all, despite being part of the [Printexc] module.)
+    Those function allow to traverse the slots of a raw backtrace,
+    extract information from them in a programmer-friendly format.
+*)
 
-    @since 4.01.0
+type backtrace_slot
+(** The abstract type [backtrace_slot] represents a single slot of
+    a backtrace.
+
+    @since 4.02
+*)
+
+val backtrace_slots : raw_backtrace -> backtrace_slot array option
+(** Returns the slots of a raw backtrace, or [None] if none of them
+    contain useful information.
+
+    In the return array, the slot at index [0] corresponds to the most
+    recent function call, raise, or primitive [get_backtrace] call in
+    the trace.
+
+    Some possible reasons for returning [None] are as follow:
+    - none of the slots in the trace come from modules compiled with
+    debug information ([-g])
+    - the program is a bytecode program that has not been linked with
+    debug information enabled ([ocamlc -g])
+*)
+
+type location = {
+  filename : string;
+  line_number : int;
+  start_char : int;
+  end_char : int;
+}
+(** The type of location information found in backtraces. [start_char]
+    and [end_char] are positions relative to the beginning of the
+    line.
+
+    @since 4.02
+*)
+
+module Slot : sig
+  type t = backtrace_slot
+
+  val is_raise : t -> bool
+  (** [is_raise slot] is [true] when [slot] refers to a raising
+      point in the code, and [false] when it comes from a simple
+      function call.
+
+      @since 4.02
+  *)
+
+  val location : t -> location option
+  (** [location slot] returns the location information of the slot,
+      if available, and [None] otherwise.
+
+      Some possible reasons for failing to return a location are as follow:
+      - the slot corresponds to a compiler-inserted raise
+      - the slot corresponds to a part of the program that has not been
+      compiled with debug information ([-g])
+
+      @since 4.02
+  *)
+
+  val format : int -> t -> string option
+  (** [format pos slot] returns the string representation of [slot] as
+      [raw_backtrace_to_string] would format it, assuming it is the
+      [pos]-th element of the backtrace: the [0]-th element is
+      pretty-printed differently than the others.
+
+      Whole-backtrace printing functions also skip some uninformative
+      slots; in that case, [format pos slot] returns [None].
+
+      @since 4.02
+  *)
+end
+
+
+(** {6 Raw backtrace slots} *)
+
+type raw_backtrace_slot
+(** This type allows direct access to raw backtrace slots, without any
+    conversion in an OCaml-usable data-structure. Being
+    process-specific, they must absolutely not be marshalled, and are
+    unsafe to use for this reason (marshalling them may not fail, but
+    un-marshalling and using the result will result in
+    undefined behavior).
+
+    Elements of this type can still be compared and hashed: when two
+    elements are equal, then they represent the same source location
+    (the converse is not necessarily true in presence of inlining,
+    for example).
+*)
+
+val raw_backtrace_length : raw_backtrace -> int
+(** [raw_backtrace_length bckt] returns the number of slots in the
+    backtrace [bckt].
+
+    @since 4.02
+*)
+
+val get_raw_backtrace_slot : raw_backtrace -> int -> raw_backtrace_slot
+(** [get_slot bckt pos] returns the slot in position [pos] in the
+    backtrace [bckt].
+
+    @since 4.02
+*)
+
+val convert_raw_backtrace_slot : raw_backtrace_slot -> backtrace_slot
+(** Extracts the user-friendly [backtrace_slot] from a low-level
+    [raw_backtrace_slot].
+
+    @since 4.02
 *)
 
 
diff --git a/stdlib/printf.ml b/stdlib/printf.ml
index 3801692047..1152429f9a 100644
--- a/stdlib/printf.ml
+++ b/stdlib/printf.ml
@@ -11,728 +11,29 @@
 (*                                                                     *)
 (***********************************************************************)
 
-external format_float: string -> float -> string
-  = "caml_format_float"
-external format_int: string -> int -> string
-  = "caml_format_int"
-external format_int32: string -> int32 -> string
-  = "caml_int32_format"
-external format_nativeint: string -> nativeint -> string
-  = "caml_nativeint_format"
-external format_int64: string -> int64 -> string
-  = "caml_int64_format"
-
-module Sformat = struct
-
-  type index;;
-
-  external unsafe_index_of_int : int -> index = "%identity"
-  ;;
-  let index_of_int i =
-    if i >= 0 then unsafe_index_of_int i
-    else failwith ("Sformat.index_of_int: negative argument " ^ string_of_int i)
-  ;;
-  external int_of_index : index -> int = "%identity"
-  ;;
-
-  let add_int_index i idx = index_of_int (i + int_of_index idx);;
-  let succ_index = add_int_index 1;;
-  (* Literal position are one-based (hence pred p instead of p). *)
-  let index_of_literal_position p = index_of_int (pred p);;
-
-  external length : ('a, 'b, 'c, 'd, 'e, 'f) format6 -> int
-    = "%string_length"
-  ;;
-  external get : ('a, 'b, 'c, 'd, 'e, 'f) format6 -> int -> char
-    = "%string_safe_get"
-  ;;
-  external unsafe_get : ('a, 'b, 'c, 'd, 'e, 'f) format6 -> int -> char
-    = "%string_unsafe_get"
-  ;;
-  external unsafe_to_string : ('a, 'b, 'c, 'd, 'e, 'f) format6 -> string
-    = "%identity"
-  ;;
-  let sub fmt idx len =
-    String.sub (unsafe_to_string fmt) (int_of_index idx) len
-  ;;
-  let to_string fmt = sub fmt (unsafe_index_of_int 0) (length fmt)
-  ;;
-
-end
-;;
-
-let bad_conversion sfmt i c =
-  invalid_arg
-    ("Printf: bad conversion %" ^ String.make 1 c ^ ", at char number " ^
-     string_of_int i ^ " in format string \'" ^ sfmt ^ "\'")
-;;
-
-let bad_conversion_format fmt i c =
-  bad_conversion (Sformat.to_string fmt) i c
-;;
-
-let incomplete_format fmt =
-  invalid_arg
-    ("Printf: premature end of format string \'" ^
-     Sformat.to_string fmt ^ "\'")
-;;
-
-(* Parses a string conversion to return the specified length and the
-   padding direction. *)
-let parse_string_conversion sfmt =
-  let rec parse neg i =
-    if i >= String.length sfmt then (0, neg) else
-    match String.unsafe_get sfmt i with
-    | '1'..'9' ->
-      (int_of_string
-         (String.sub sfmt i (String.length sfmt - i - 1)),
-       neg)
-    | '-' ->
-      parse true (succ i)
-    | _ ->
-      parse neg (succ i) in
-  try parse false 1 with
-  | Failure _ -> bad_conversion sfmt 0 's'
-;;
-
-(* Pad a (sub) string into a blank string of length [p],
-   on the right if [neg] is true, on the left otherwise. *)
-let pad_string pad_char p neg s i len =
-  if p = len && i = 0 then s else
-  if p <= len then String.sub s i len else
-  let res = String.make p pad_char in
-  if neg
-  then String.blit s i res 0 len
-  else String.blit s i res (p - len) len;
-  res
-;;
-
-(* Format a string given a %s format, e.g. %40s or %-20s.
-   To do ?: ignore other flags (#, +, etc). *)
-let format_string sfmt s =
-  let (p, neg) = parse_string_conversion sfmt in
-  pad_string ' ' p neg s 0 (String.length s)
-;;
-
-(* Extract a format string out of [fmt] between [start] and [stop] inclusive.
-   ['*'] in the format are replaced by integers taken from the [widths] list.
-   [extract_format] returns a string which is the string representation of
-   the resulting format string. *)
-let extract_format fmt start stop widths =
-  let skip_positional_spec start =
-    match Sformat.unsafe_get fmt start with
-    | '0'..'9' ->
-      let rec skip_int_literal i =
-        match Sformat.unsafe_get fmt i with
-        | '0'..'9' -> skip_int_literal (succ i)
-        | '$' -> succ i
-        | _ -> start in
-      skip_int_literal (succ start)
-    | _ -> start in
-  let start = skip_positional_spec (succ start) in
-  let b = Buffer.create (stop - start + 10) in
-  Buffer.add_char b '%';
-  let rec fill_format i widths =
-    if i <= stop then
-      match (Sformat.unsafe_get fmt i, widths) with
-      | ('*', h :: t) ->
-        Buffer.add_string b (string_of_int h);
-        let i = skip_positional_spec (succ i) in
-        fill_format i t
-      | ('*', []) ->
-        assert false (* Should not happen since this is ill-typed. *)
-      | (c, _) ->
-        Buffer.add_char b c;
-        fill_format (succ i) widths in
-  fill_format start (List.rev widths);
-  Buffer.contents b
-;;
-
-let extract_format_int conv fmt start stop widths =
-  let sfmt = extract_format fmt start stop widths in
-  match conv with
-  | 'n' | 'N' ->
-    sfmt.[String.length sfmt - 1] <- 'u';
-    sfmt
-  | _ -> sfmt
-;;
-
-let extract_format_float conv fmt start stop widths =
-  let sfmt = extract_format fmt start stop widths in
-  match conv with
-  | 'F' ->
-    sfmt.[String.length sfmt - 1] <- 'g';
-    sfmt
-  | _ -> sfmt
-;;
-
-(* Returns the position of the next character following the meta format
-   string, starting from position [i], inside a given format [fmt].
-   According to the character [conv], the meta format string is
-   enclosed by the delimiters %{ and %} (when [conv = '{']) or %( and
-   %) (when [conv = '(']). Hence, [sub_format] returns the index of
-   the character following the [')'] or ['}'] that ends the meta format,
-   according to the character [conv]. *)
-let sub_format incomplete_format bad_conversion_format conv fmt i =
-  let len = Sformat.length fmt in
-  let rec sub_fmt c i =
-    let close = if c = '(' then ')' else (* '{' *) '}' in
-    let rec sub j =
-       if j >= len then incomplete_format fmt else
-       match Sformat.get fmt j with
-       | '%' -> sub_sub (succ j)
-       | _ -> sub (succ j)
-    and sub_sub j =
-       if j >= len then incomplete_format fmt else
-       match Sformat.get fmt j with
-       | '(' | '{' as c ->
-         let j = sub_fmt c (succ j) in
-         sub (succ j)
-       | '}' | ')' as c ->
-         if c = close then succ j else bad_conversion_format fmt i c
-       | _ -> sub (succ j) in
-    sub i in
-  sub_fmt conv i
-;;
-
-let sub_format_for_printf conv =
-  sub_format incomplete_format bad_conversion_format conv
-;;
-
-let iter_on_format_args fmt add_conv add_char =
-
-  let lim = Sformat.length fmt - 1 in
-
-  let rec scan_flags skip i =
-    if i > lim then incomplete_format fmt else
-    match Sformat.unsafe_get fmt i with
-    | '*' -> scan_flags skip (add_conv skip i 'i')
- (* | '$' -> scan_flags skip (succ i) *** PR#4321 *)
-    | '#' | '-' | ' ' | '+' -> scan_flags skip (succ i)
-    | '_' -> scan_flags true (succ i)
-    | '0'..'9'
-    | '.' -> scan_flags skip (succ i)
-    | _ -> scan_conv skip i
-  and scan_conv skip i =
-    if i > lim then incomplete_format fmt else
-    match Sformat.unsafe_get fmt i with
-    | '%' | '@' | '!' | ',' -> succ i
-    | 's' | 'S' | '[' -> add_conv skip i 's'
-    | 'c' | 'C' -> add_conv skip i 'c'
-    | 'd' | 'i' |'o' | 'u' | 'x' | 'X' | 'N' -> add_conv skip i 'i'
-    | 'f' | 'e' | 'E' | 'g' | 'G' | 'F' -> add_conv skip i 'f'
-    | 'B' | 'b' -> add_conv skip i 'B'
-    | 'a' | 'r' | 't' as conv -> add_conv skip i conv
-    | 'l' | 'n' | 'L' as conv ->
-      let j = succ i in
-      if j > lim then add_conv skip i 'i' else begin
-        match Sformat.get fmt j with
-        | 'd' | 'i' | 'o' | 'u' | 'x' | 'X' ->
-          add_char (add_conv skip i conv) 'i'
-        | _ -> add_conv skip i 'i' end
-    | '{' as conv ->
-      (* Just get a regular argument, skipping the specification. *)
-      let i = add_conv skip i conv in
-      (* To go on, find the index of the next char after the meta format. *)
-      let j = sub_format_for_printf conv fmt i in
-      (* Add the meta specification to the summary anyway. *)
-      let rec loop i =
-        if i < j - 2 then loop (add_char i (Sformat.get fmt i)) in
-      loop i;
-      (* Go on, starting at the closing brace to properly close the meta
-         specification in the summary. *)
-      scan_conv skip (j - 1)
-    | '(' as conv ->
-      (* Use the static format argument specification instead of
-         the runtime format argument value: they must have the same type
-         anyway. *)
-      scan_fmt (add_conv skip i conv)
-    | '}' | ')' as conv -> add_conv skip i conv
-    | conv -> bad_conversion_format fmt i conv
-
-  and scan_fmt i =
-    if i < lim then
-     if Sformat.get fmt i = '%'
-     then scan_fmt (scan_flags false (succ i))
-     else scan_fmt (succ i)
-    else i in
-
-  ignore (scan_fmt 0)
-;;
-
-(* Returns a string that summarizes the typing information that a given
-   format string contains.
-   For instance, [summarize_format_type "A number %d\n"] is "%i".
-   It also checks the well-formedness of the format string. *)
-let summarize_format_type fmt =
-  let len = Sformat.length fmt in
-  let b = Buffer.create len in
-  let add_char i c = Buffer.add_char b c; succ i in
-  let add_conv skip i c =
-    if skip then Buffer.add_string b "%_" else Buffer.add_char b '%';
-    add_char i c in
-  iter_on_format_args fmt add_conv add_char;
-  Buffer.contents b
-;;
-
-module Ac = struct
-  type ac = {
-    mutable ac_rglr : int;
-    mutable ac_skip : int;
-    mutable ac_rdrs : int;
-  }
-end
-;;
-
-open Ac;;
-
-(* Computes the number of arguments of a format (including the flag
-   arguments if any). *)
-let ac_of_format fmt =
-  let ac = { ac_rglr = 0; ac_skip = 0; ac_rdrs = 0; } in
-  let incr_ac skip c =
-    let inc = if c = 'a' then 2 else 1 in
-    if c = 'r' then ac.ac_rdrs <- ac.ac_rdrs + 1;
-    if skip
-    then ac.ac_skip <- ac.ac_skip + inc
-    else ac.ac_rglr <- ac.ac_rglr + inc in
-  let add_conv skip i c =
-    (* Just finishing a meta format: no additional argument to record. *)
-    if c <> ')' && c <> '}' then incr_ac skip c;
-    succ i
-  and add_char i _ = succ i in
-
-  iter_on_format_args fmt add_conv add_char;
-  ac
-;;
-
-let count_printing_arguments_of_format fmt =
-  let ac = ac_of_format fmt in
-  (* For printing, only the regular arguments have to be counted. *)
-  ac.ac_rglr
-;;
-
-let list_iter_i f l =
-  let rec loop i = function
-  | [] -> ()
-  | [x] -> f i x (* Tail calling [f] *)
-  | x :: xs -> f i x; loop (succ i) xs in
-  loop 0 l
-;;
-
-(* 'Abstracting' version of kprintf: returns a (curried) function that
-   will print when totally applied.
-   Note: in the following, we are careful not to be badly caught
-   by the compiler optimizations for the representation of arrays. *)
-let kapr kpr fmt =
-  match count_printing_arguments_of_format fmt with
-  | 0 -> kpr fmt [||]
-  | 1 -> Obj.magic (fun x ->
-      let a = Array.make 1 (Obj.repr 0) in
-      a.(0) <- x;
-      kpr fmt a)
-  | 2 -> Obj.magic (fun x y ->
-      let a = Array.make 2 (Obj.repr 0) in
-      a.(0) <- x; a.(1) <- y;
-      kpr fmt a)
-  | 3 -> Obj.magic (fun x y z ->
-      let a = Array.make 3 (Obj.repr 0) in
-      a.(0) <- x; a.(1) <- y; a.(2) <- z;
-      kpr fmt a)
-  | 4 -> Obj.magic (fun x y z t ->
-      let a = Array.make 4 (Obj.repr 0) in
-      a.(0) <- x; a.(1) <- y; a.(2) <- z;
-      a.(3) <- t;
-      kpr fmt a)
-  | 5 -> Obj.magic (fun x y z t u ->
-      let a = Array.make 5 (Obj.repr 0) in
-      a.(0) <- x; a.(1) <- y; a.(2) <- z;
-      a.(3) <- t; a.(4) <- u;
-      kpr fmt a)
-  | 6 -> Obj.magic (fun x y z t u v ->
-      let a = Array.make 6 (Obj.repr 0) in
-      a.(0) <- x; a.(1) <- y; a.(2) <- z;
-      a.(3) <- t; a.(4) <- u; a.(5) <- v;
-      kpr fmt a)
-  | nargs ->
-    let rec loop i args =
-      if i >= nargs then
-        let a = Array.make nargs (Obj.repr 0) in
-        list_iter_i (fun i arg -> a.(nargs - i - 1) <- arg) args;
-        kpr fmt a
-      else Obj.magic (fun x -> loop (succ i) (x :: args)) in
-    loop 0 []
-;;
-
-type positional_specification =
-   | Spec_none | Spec_index of Sformat.index
-;;
-
-(* To scan an optional positional parameter specification,
-   i.e. an integer followed by a [$].
-
-   Calling [got_spec] with appropriate arguments, we 'return' a positional
-   specification and an index to go on scanning the [fmt] format at hand.
-
-   Note that this is optimized for the regular case, i.e. no positional
-   parameter, since in this case we juste 'return' the constant
-   [Spec_none]; in case we have a positional parameter, we 'return' a
-   [Spec_index] [positional_specification] which is a bit more costly.
-
-   Note also that we do not support [*$] specifications, since this would
-   lead to type checking problems: a [*$] positional specification means
-   'take the next argument to [printf] (which must be an integer value)',
-   name this integer value $n$; [*$] now designates parameter $n$.
-
-   Unfortunately, the type of a parameter specified via a [*$] positional
-   specification should be the type of the corresponding argument to
-   [printf], hence this should be the type of the $n$-th argument to [printf]
-   with $n$ being the {\em value} of the integer argument defining [*]; we
-   clearly cannot statically guess the value of this parameter in the general
-   case. Put it another way: this means type dependency, which is completely
-   out of scope of the OCaml type algebra. *)
-
-let scan_positional_spec fmt got_spec i =
-  match Sformat.unsafe_get fmt i with
-  | '0'..'9' as d ->
-    let rec get_int_literal accu j =
-      match Sformat.unsafe_get fmt j with
-      | '0'..'9' as d ->
-        get_int_literal (10 * accu + (int_of_char d - 48)) (succ j)
-      | '$' ->
-        if accu = 0 then
-          failwith "printf: bad positional specification (0)." else
-        got_spec (Spec_index (Sformat.index_of_literal_position accu)) (succ j)
-      (* Not a positional specification: tell so the caller, and go back to
-         scanning the format from the original [i] position we were called at
-         first. *)
-      | _ -> got_spec Spec_none i in
-    get_int_literal (int_of_char d - 48) (succ i)
-  (* No positional specification: tell so the caller, and go back to scanning
-     the format from the original [i] position. *)
-  | _ -> got_spec Spec_none i
-;;
-
-(* Get the index of the next argument to printf, according to the given
-   positional specification. *)
-let next_index spec n =
-  match spec with
-  | Spec_none -> Sformat.succ_index n
-  | Spec_index _ -> n
-;;
-
-(* Get the index of the actual argument to printf, according to its
-   optional positional specification. *)
-let get_index spec n =
-  match spec with
-  | Spec_none -> n
-  | Spec_index p -> p
-;;
-
-(* Format a float argument as a valid OCaml lexeme. *)
-let format_float_lexeme =
-
-  (* To be revised: this procedure should be a unique loop that performs the
-     validity check and the string lexeme modification at the same time.
-     Otherwise, it is too difficult to handle the strange padding facilities
-     given by printf. Let alone handling the correct widths indication,
-     knowing that we have sometime to add a '.' at the end of the result!
-  *)
-
-  let make_valid_float_lexeme s =
-    (* Check if s is already a valid lexeme:
-       in this case do nothing,
-       otherwise turn s into a valid OCaml lexeme. *)
-    let l = String.length s in
-    let rec valid_float_loop i =
-      if i >= l then s ^ "." else
-      match s.[i] with
-      (* Sure, this is already a valid float lexeme. *)
-      | '.' | 'e' | 'E' -> s
-      | _ -> valid_float_loop (i + 1) in
-
-    valid_float_loop 0 in
-
-  (fun sfmt x ->
-   match classify_float x with
-   | FP_normal | FP_subnormal | FP_zero ->
-       make_valid_float_lexeme (format_float sfmt x)
-   | FP_infinite ->
-       if x < 0.0 then "neg_infinity" else "infinity"
-   | FP_nan ->
-       "nan")
-;;
-
-(* Decode a format string and act on it.
-   [fmt] is the [printf] format string, and [pos] points to a [%] character in
-   the format string.
-   After consuming the appropriate number of arguments and formatting
-   them, one of the following five continuations described below is called:
-
-   - [cont_s] for outputting a string
-     (arguments: arg num, string, next pos)
-   - [cont_a] for performing a %a action
-     (arguments: arg num, fn, arg, next pos)
-   - [cont_t] for performing a %t action
-     (arguments: arg num, fn, next pos)
-   - [cont_f] for performing a flush action
-     (arguments: arg num, next pos)
-   - [cont_m] for performing a %( action
-     (arguments: arg num, sfmt, next pos)
-
-   "arg num" is the index in array [args] of the next argument to [printf].
-   "next pos" is the position in [fmt] of the first character following
-   the %conversion specification in [fmt]. *)
-
-(* Note: here, rather than test explicitly against [Sformat.length fmt]
-   to detect the end of the format, we use [Sformat.unsafe_get] and
-   rely on the fact that we'll get a "null" character if we access
-   one past the end of the string.  These "null" characters are then
-   caught by the [_ -> bad_conversion] clauses below.
-   Don't do this at home, kids. *)
-let scan_format fmt args n pos cont_s cont_a cont_t cont_f cont_m =
-
-  let get_arg spec n =
-    Obj.magic (args.(Sformat.int_of_index (get_index spec n))) in
-
-  let rec scan_positional n widths i =
-    let got_spec spec i = scan_flags spec n widths i in
-    scan_positional_spec fmt got_spec i
-
-  and scan_flags spec n widths i =
-    match Sformat.unsafe_get fmt i with
-    | '*' ->
-      let got_spec wspec i =
-        let (width : int) = get_arg wspec n in
-        scan_flags spec (next_index wspec n) (width :: widths) i in
-      scan_positional_spec fmt got_spec (succ i)
-    | '0'..'9'
-    | '.' | '#' | '-' | ' ' | '+' -> scan_flags spec n widths (succ i)
-    | _ -> scan_conv spec n widths i
-
-  and scan_conv spec n widths i =
-    match Sformat.unsafe_get fmt i with
-    | '%' | '@' as c ->
-      cont_s n (String.make 1 c) (succ i)
-    | '!' -> cont_f n (succ i)
-    | ',' -> cont_s n "" (succ i)
-    | 's' | 'S' as conv ->
-      let (x : string) = get_arg spec n in
-      let x = if conv = 's' then x else "\"" ^ String.escaped x ^ "\"" in
-      let s =
-        (* Optimize for common case %s *)
-        if i = succ pos then x else
-        format_string (extract_format fmt pos i widths) x in
-      cont_s (next_index spec n) s (succ i)
-    | '[' as conv ->
-      bad_conversion_format fmt i conv
-    | 'c' | 'C' as conv ->
-      let (x : char) = get_arg spec n in
-      let s =
-        if conv = 'c' then String.make 1 x else "'" ^ Char.escaped x ^ "'" in
-      cont_s (next_index spec n) s (succ i)
-    | 'd' | 'i' | 'o' | 'u' | 'x' | 'X' | 'N' as conv ->
-      let (x : int) = get_arg spec n in
-      let s =
-        format_int (extract_format_int conv fmt pos i widths) x in
-      cont_s (next_index spec n) s (succ i)
-    | 'f' | 'e' | 'E' | 'g' | 'G' ->
-      let (x : float) = get_arg spec n in
-      let s = format_float (extract_format fmt pos i widths) x in
-      cont_s (next_index spec n) s (succ i)
-    | 'F' as conv ->
-      let (x : float) = get_arg spec n in
-      let s =
-        format_float_lexeme
-          (if widths = []
-           then "%.12g"
-           else extract_format_float conv fmt pos i widths)
-          x in
-      cont_s (next_index spec n) s (succ i)
-    | 'B' | 'b' ->
-      let (x : bool) = get_arg spec n in
-      cont_s (next_index spec n) (string_of_bool x) (succ i)
-    | 'a' ->
-      let printer = get_arg spec n in
-      (* If the printer spec is Spec_none, go on as usual.
-         If the printer spec is Spec_index p,
-         printer's argument spec is Spec_index (succ_index p). *)
-      let n = Sformat.succ_index (get_index spec n) in
-      let arg = get_arg Spec_none n in
-      cont_a (next_index spec n) printer arg (succ i)
-    | 'r' as conv ->
-      bad_conversion_format fmt i conv
-    | 't' ->
-      let printer = get_arg spec n in
-      cont_t (next_index spec n) printer (succ i)
-    | 'l' | 'n' | 'L' as conv ->
-      begin match Sformat.unsafe_get fmt (succ i) with
-      | 'd' | 'i' | 'o' | 'u' | 'x' | 'X' ->
-        let i = succ i in
-        let s =
-          match conv with
-          | 'l' ->
-            let (x : int32) = get_arg spec n in
-            format_int32 (extract_format fmt pos i widths) x
-          | 'n' ->
-            let (x : nativeint) = get_arg spec n in
-            format_nativeint (extract_format fmt pos i widths) x
-          | _ ->
-            let (x : int64) = get_arg spec n in
-            format_int64 (extract_format fmt pos i widths) x in
-        cont_s (next_index spec n) s (succ i)
-      | _ ->
-        let (x : int) = get_arg spec n in
-        let s = format_int (extract_format_int 'n' fmt pos i widths) x in
-        cont_s (next_index spec n) s (succ i)
-      end
-    | '{' | '(' as conv (* ')' '}' *) ->
-      let (xf : ('a, 'b, 'c, 'd, 'e, 'f) format6) = get_arg spec n in
-      let i = succ i in
-      let i = sub_format_for_printf conv fmt i in
-      if conv = '{' (* '}' *) then
-        (* Just print the format argument as a specification. *)
-        cont_s
-          (next_index spec n)
-          (summarize_format_type xf)
-          i else
-        (* Use the format argument instead of the format specification. *)
-        cont_m (next_index spec n) xf i
-    | (* '(' *) ')' ->
-      cont_s n "" (succ i)
-    | conv ->
-      bad_conversion_format fmt i conv in
-
-  scan_positional n [] (succ pos)
-;;
-
-let mkprintf to_s get_out outc outs flush k fmt =
-
-  (* [out] is global to this definition of [pr], and must be shared by all its
-     recursive calls (if any). *)
-  let out = get_out fmt in
-  let outc c = outc out c in
-  let outs s = outs out s in
-
-  let rec pr k n fmt v =
-
-    let len = Sformat.length fmt in
-
-    let rec doprn n i =
-       if i >= len then Obj.magic (k out) else
-       match Sformat.unsafe_get fmt i with
-       | '%' -> scan_format fmt v n i cont_s cont_a cont_t cont_f cont_m
-       |  c  -> outc c; doprn n (succ i)
-
-    and cont_s n s i =
-      outs s; doprn n i
-    and cont_a n printer arg i =
-      if to_s then
-        outs ((Obj.magic printer : unit -> _ -> string) () arg)
-      else
-        printer out arg;
-      doprn n i
-    and cont_t n printer i =
-      if to_s then
-        outs ((Obj.magic printer : unit -> string) ())
-      else
-        printer out;
-      doprn n i
-    and cont_f n i =
-      flush out; doprn n i
-    and cont_m n xf i =
-      let m =
-        Sformat.add_int_index
-          (count_printing_arguments_of_format xf) n in
-      pr (Obj.magic (fun _ -> doprn m i)) n xf v in
-
-    doprn n 0 in
-
-  let kpr = pr k (Sformat.index_of_int 0) in
-
-  kapr kpr fmt
-;;
-
-(**************************************************************
-
-  Defining [fprintf] and various flavors of [fprintf].
-
- **************************************************************)
-
-let kfprintf k oc =
-  mkprintf false (fun _ -> oc) output_char output_string flush k
-;;
-let ikfprintf k oc = kapr (fun _ _ -> Obj.magic (k oc));;
-
-let fprintf oc = kfprintf ignore oc;;
-let ifprintf oc = ikfprintf ignore oc;;
-let printf fmt = fprintf stdout fmt;;
-let eprintf fmt = fprintf stderr fmt;;
-
-let kbprintf k b =
-  mkprintf false (fun _ -> b) Buffer.add_char Buffer.add_string ignore k
-;;
-let bprintf b = kbprintf ignore b;;
-
-let get_buff fmt =
-  let len = 2 * Sformat.length fmt in
-  Buffer.create len
-;;
-
-let get_contents b =
-  let s = Buffer.contents b in
-  Buffer.clear b;
-  s
-;;
-
-let get_cont k b = k (get_contents b);;
-
-let ksprintf k =
-  mkprintf true get_buff Buffer.add_char Buffer.add_string ignore (get_cont k)
-;;
-
-let sprintf fmt = ksprintf (fun s -> s) fmt;;
-
-(**************************************************************
-
-  Deprecated stuff.
-
- **************************************************************)
-
-let kprintf = ksprintf;;
-
-(* For OCaml system internal use only: needed to implement modules [Format]
-  and [Scanf]. *)
-
-module CamlinternalPr = struct
-
-  module Sformat = Sformat;;
-
-  module Tformat = struct
-
-    type ac =
-      Ac.ac = {
-      mutable ac_rglr : int;
-      mutable ac_skip : int;
-      mutable ac_rdrs : int;
-    }
-    ;;
-
-    let ac_of_format = ac_of_format;;
-
-    let count_printing_arguments_of_format =
-      count_printing_arguments_of_format;;
-
-    let sub_format = sub_format;;
-
-    let summarize_format_type = summarize_format_type;;
-
-    let scan_format = scan_format;;
-
-    let kapr = kapr;;
-
-  end
-  ;;
-
-end
-;;
+open CamlinternalFormatBasics
+open CamlinternalFormat
+
+let kfprintf k o (Format (fmt, _)) =
+  make_printf (fun o acc -> output_acc o acc; k o) o End_of_acc fmt
+let kbprintf k b (Format (fmt, _)) =
+  make_printf (fun b acc -> bufput_acc b acc; k b) b End_of_acc fmt
+let ikfprintf k oc (Format (fmt, _)) =
+  make_printf (fun oc _ -> k oc) oc End_of_acc fmt
+
+let fprintf oc fmt = kfprintf ignore oc fmt
+let bprintf b fmt = kbprintf ignore b fmt
+let ifprintf oc fmt = ikfprintf ignore oc fmt
+let printf fmt = fprintf stdout fmt
+let eprintf fmt = fprintf stderr fmt
+
+let ksprintf k (Format (fmt, _)) =
+  let k' () acc =
+    let buf = Buffer.create 64 in
+    strput_acc buf acc;
+    k (Buffer.contents buf) in
+  make_printf k' () End_of_acc fmt
+
+let sprintf fmt = ksprintf (fun s -> s) fmt
+
+let kprintf = ksprintf
diff --git a/stdlib/printf.mli b/stdlib/printf.mli
index a75a64181d..21e28159af 100644
--- a/stdlib/printf.mli
+++ b/stdlib/printf.mli
@@ -163,76 +163,5 @@ val kbprintf : (Buffer.t -> 'a) -> Buffer.t ->
 
 (** Deprecated *)
 
-val kprintf : (string -> 'a) -> ('b, unit, string, 'a) format4 -> 'b;;
+val kprintf : (string -> 'a) -> ('b, unit, string, 'a) format4 -> 'b
 (** A deprecated synonym for [ksprintf]. *)
-
-(**/**)
-
-(* The following is for system use only. Do not call directly. *)
-
-module CamlinternalPr : sig
-
-  module Sformat : sig
-    type index;;
-
-    val index_of_int : int -> index;;
-    external int_of_index : index -> int = "%identity";;
-    external unsafe_index_of_int : int -> index = "%identity";;
-
-    val succ_index : index -> index;;
-    val add_int_index : int -> index -> index;;
-
-    val sub : ('a, 'b, 'c, 'd, 'e, 'f) format6 -> index -> int -> string;;
-    val to_string : ('a, 'b, 'c, 'd, 'e, 'f) format6 -> string;;
-    external length : ('a, 'b, 'c, 'd, 'e, 'f) format6 -> int
-      = "%string_length";;
-    external get : ('a, 'b, 'c, 'd, 'e, 'f) format6 -> int -> char
-      = "%string_safe_get";;
-    external unsafe_to_string : ('a, 'b, 'c, 'd, 'e, 'f) format6 -> string
-      = "%identity";;
-    external unsafe_get : ('a, 'b, 'c, 'd, 'e, 'f) format6 -> int -> char
-      = "%string_unsafe_get";;
-
-  end;;
-
-  module Tformat : sig
-
-    type ac = {
-      mutable ac_rglr : int;
-      mutable ac_skip : int;
-      mutable ac_rdrs : int;
-    };;
-
-    val ac_of_format : ('a, 'b, 'c, 'd, 'e, 'f) format6 -> ac;;
-    val count_printing_arguments_of_format :
-      ('a, 'b, 'c, 'd, 'e, 'f) format6 -> int;;
-
-    val sub_format :
-        (('a, 'b, 'c, 'd, 'e, 'f) format6 -> int) ->
-        (('a, 'b, 'c, 'd, 'e, 'f) format6 -> int -> char -> int) ->
-        char ->
-        ('a, 'b, 'c, 'd, 'e, 'f) format6 ->
-        int ->
-        int
-
-    val summarize_format_type : ('a, 'b, 'c, 'd, 'e, 'f) format6 -> string
-
-    val scan_format : ('a, 'b, 'c, 'd, 'e, 'f) format6 ->
-        'g array ->
-        Sformat.index ->
-        int ->
-        (Sformat.index -> string -> int -> 'h) ->
-        (Sformat.index -> 'i -> 'j -> int -> 'h) ->
-        (Sformat.index -> 'k -> int -> 'h) ->
-        (Sformat.index -> int -> 'h) ->
-        (Sformat.index -> ('l, 'm, 'n, 'o, 'p, 'q) format6 -> int -> 'h) ->
-        'h
-
-    val kapr :
-        (('a, 'b, 'c, 'd, 'e, 'f) format6 -> Obj.t array -> 'g) ->
-        ('a, 'b, 'c, 'd, 'e, 'f) format6 ->
-        'g
-
-  end;;
-
-end;;
diff --git a/stdlib/scanf.ml b/stdlib/scanf.ml
index 8f694fd3a2..c21de72484 100644
--- a/stdlib/scanf.ml
+++ b/stdlib/scanf.ml
@@ -11,6 +11,19 @@
 (*                                                                     *)
 (***********************************************************************)
 
+open CamlinternalFormatBasics
+open CamlinternalFormat
+
+(* alias to avoid warning for ambiguity between
+   Pervasives.format6
+   and CamlinternalFormatBasics.format6
+
+   (the former is in fact an alias for the latter,
+    but the ambiguity warning doesn't care)
+*)
+type ('a, 'b, 'c, 'd, 'e, 'f) format6 =
+  ('a, 'b, 'c, 'd, 'e, 'f) Pervasives.format6
+
 (* The run-time library for scanners. *)
 
 (* Scanning buffers. *)
@@ -318,17 +331,17 @@ module Scanning : SCANNING = struct
 
   let from_ic scan_close_ic iname ic =
     let len = !file_buffer_size in
-    let buf = String.create len in
+    let buf = Bytes.create len in
     let i = ref 0 in
     let lim = ref 0 in
     let eof = ref false in
     let next () =
-      if !i < !lim then begin let c = buf.[!i] in incr i; c end else
+      if !i < !lim then begin let c = Bytes.get buf !i in incr i; c end else
       if !eof then raise End_of_file else begin
         lim := input ic buf 0 len;
         if !lim = 0 then begin eof := true; scan_close_ic ic end else begin
           i := 1;
-          buf.[0]
+          Bytes.get buf 0
         end
       end in
     create iname next
@@ -402,11 +415,6 @@ end
 
 type ('a, 'b, 'c, 'd) scanner =
      ('a, Scanning.in_channel, 'b, 'c, 'a -> 'd, 'd) format6 -> 'c
-;;
-
-external string_to_format :
- string -> ('a, 'b, 'c, 'd, 'e, 'f) format6 = "%identity"
-;;
 
 (* Reporting errors. *)
 exception Scan_failure of string;;
@@ -429,33 +437,6 @@ let bad_end_of_input message =
     (Printf.sprintf
        "scanning of %s failed: \
         premature end of file occurred before end of token" message)
-;;
-
-let int_of_width_opt = function
-  | None -> max_int
-  | Some width -> width
-;;
-
-let int_of_prec_opt = function
-  | None -> max_int
-  | Some prec -> prec
-;;
-
-module Sformat = Printf.CamlinternalPr.Sformat;;
-module Tformat = Printf.CamlinternalPr.Tformat;;
-
-let bad_conversion fmt i c =
-  invalid_arg
-    (Printf.sprintf
-       "scanf: bad conversion %%%C, at char number %i \
-        in format string \'%s\'" c i (Sformat.to_string fmt))
-;;
-
-let incomplete_format fmt =
-  invalid_arg
-    (Printf.sprintf "scanf: premature end of format string \'%s\'"
-       (Sformat.to_string fmt))
-;;
 
 let bad_float () =
   bad_input "no dot or exponent part found in float token"
@@ -467,19 +448,15 @@ let character_mismatch_err c ci =
 
 let character_mismatch c ci =
   bad_input (character_mismatch_err c ci)
-;;
-
-let format_mismatch_err fmt1 fmt2 =
-  Printf.sprintf
-    "format read \'%s\' does not match specification \'%s\'" fmt1 fmt2
-;;
-
-let format_mismatch fmt1 fmt2 = bad_input (format_mismatch_err fmt1 fmt2);;
 
-(* Checking that 2 format strings are type compatible. *)
-let compatible_format_type fmt1 fmt2 =
-  Tformat.summarize_format_type (string_to_format fmt1) =
-  Tformat.summarize_format_type (string_to_format fmt2);;
+let rec skip_whites ib =
+  let c = Scanning.peek_char ib in
+  if not (Scanning.eof ib) then begin
+    match c with
+    | ' ' | '\t' | '\n' | '\r' ->
+      Scanning.invalidate_current_char ib; skip_whites ib
+    | _ -> ()
+  end
 
 (* Checking that [c] is indeed in the input, then skips it.
    In this case, the character [c] has been explicitly specified in the
@@ -496,28 +473,13 @@ let compatible_format_type fmt1 fmt2 =
    We are also careful to treat "\r\n" in the input as an end of line marker:
    it always matches a '\n' specification in the input format string. *)
 let rec check_char ib c =
-  let ci = Scanning.checked_peek_char ib in
-  if ci = c then Scanning.invalidate_current_char ib else begin
-    match ci with
-    | '\r' when c = '\n' ->
-      Scanning.invalidate_current_char ib; check_char ib '\n'
-    | _ -> character_mismatch c ci
-  end
-;;
-
-(* Checks that the current char is indeed one of the stopper characters,
-   then skips it.
-   Be careful that if ib has no more character this procedure should
-   just do nothing (since %s@c defaults to the entire rest of the
-   buffer, when no character c can be found in the input). *)
-let ignore_stoppers stps ib =
-  if stps <> [] && not (Scanning.eof ib) then
-  let ci = Scanning.peek_char ib in
-  if List.memq ci stps then Scanning.invalidate_current_char ib else
-  let sr = String.concat "" (List.map (String.make 1) stps) in
-  bad_input
-    (Printf.sprintf "looking for one of range %S, found %C" sr ci)
-;;
+  if c = ' ' then skip_whites ib else
+    let ci = Scanning.checked_peek_char ib in
+    if ci = c then Scanning.invalidate_current_char ib else
+      match ci with
+      | '\r' when c = '\n' ->
+        Scanning.invalidate_current_char ib; check_char ib '\n'
+      | _ -> character_mismatch c ci
 
 (* Extracting tokens from the output token buffer. *)
 
@@ -701,7 +663,7 @@ let scan_optionally_signed_int width ib =
   scan_unsigned_int width ib
 ;;
 
-let scan_int_conv conv width _prec ib =
+let scan_int_conv conv width ib =
   match conv with
   | 'b' -> scan_binary_int width ib
   | 'd' -> scan_optionally_signed_decimal_int width ib
@@ -791,7 +753,7 @@ let scan_float width precision ib =
     scan_exp_part width ib, precision
 ;;
 
-let scan_Float width precision ib =
+let scan_caml_float width precision ib =
   let width = scan_optionally_signed_decimal_int width ib in
   if width = 0 then bad_float () else
   let c = Scanning.peek_char ib in
@@ -805,12 +767,11 @@ let scan_Float width precision ib =
   | 'e' | 'E' ->
     scan_exp_part width ib
   | _ -> bad_float ()
-;;
 
 (* Scan a regular string:
    stops when encountering a space, if no scanning indication has been given;
-   otherwise, stops when encountering one of the characters in the scanning
-   indication list [stp].
+   otherwise, stops when encountering the characters in the scanning
+   indication [stp].
    It also stops at end of file or when the maximum number of characters has
    been read.*)
 let scan_string stp width ib =
@@ -818,12 +779,14 @@ let scan_string stp width ib =
     if width = 0 then width else
     let c = Scanning.peek_char ib in
     if Scanning.eof ib then width else
-    if stp = [] then
-      match c with
-      | ' ' | '\t' | '\n' | '\r' -> width
-      | c -> loop (Scanning.store_char width ib c) else
-    if List.memq c stp then Scanning.skip_char width ib else
-    loop (Scanning.store_char width ib c) in
+      match stp with
+      | Some c' when c = c' -> Scanning.skip_char width ib
+      | Some _ -> loop (Scanning.store_char width ib c)
+      | None ->
+        match c with
+        | ' ' | '\t' | '\n' | '\r' -> width
+        | _ -> loop (Scanning.store_char width ib c)
+  in
   loop width
 ;;
 
@@ -925,7 +888,7 @@ let scan_backslash_char width ib =
 ;;
 
 (* Scan a character (an OCaml token). *)
-let scan_Char width ib =
+let scan_caml_char width ib =
 
   let rec find_start width =
     match Scanning.checked_peek_char ib with
@@ -948,7 +911,7 @@ let scan_Char width ib =
 ;;
 
 (* Scan a delimited string (an OCaml token). *)
-let scan_String width ib =
+let scan_caml_string width ib =
 
   let rec find_start width =
     match Scanning.checked_peek_char ib with
@@ -981,8 +944,7 @@ let scan_String width ib =
 ;;
 
 (* Scan a boolean (an OCaml token). *)
-let scan_bool width ib =
-  if width < 4 then bad_token_length "a boolean" else
+let scan_bool ib =
   let c = Scanning.checked_peek_char ib in
   let m =
     match c with
@@ -991,560 +953,383 @@ let scan_bool width ib =
     | c ->
       bad_input
         (Printf.sprintf "the character %C cannot start a boolean" c) in
-  scan_string [] (min width m) ib
-;;
-
-(* Reading char sets in %[...] conversions. *)
-type char_set =
-   | Pos_set of string (* Positive (regular) set. *)
-   | Neg_set of string (* Negative (complementary) set. *)
-;;
-
-
-(* Char sets are read as sub-strings in the format string. *)
-let scan_range fmt j =
-
-  let len = Sformat.length fmt in
-
-  let buffer = Buffer.create len in
-
-  let rec scan_closing j =
-    if j >= len then incomplete_format fmt else
-    match Sformat.get fmt j with
-    | ']' -> j, Buffer.contents buffer
-    | '%' ->
-      let j = j + 1 in
-      if j >= len then incomplete_format fmt else
-      begin match Sformat.get fmt j with
-      | '%' | '@' as c ->
-        Buffer.add_char buffer c;
-        scan_closing (j + 1)
-      | c -> bad_conversion fmt j c
-      end
-    | c ->
-      Buffer.add_char buffer c;
-      scan_closing (j + 1) in
-
-  let scan_first_pos j =
-    if j >= len then incomplete_format fmt else
-    match Sformat.get fmt j with
-    | ']' as c ->
-      Buffer.add_char buffer c;
-      scan_closing (j + 1)
-    | _ -> scan_closing j in
-
-  let scan_first_neg j =
-    if j >= len then incomplete_format fmt else
-    match Sformat.get fmt j with
-    | '^' ->
-      let j = j + 1 in
-      let k, char_set = scan_first_pos j in
-      k, Neg_set char_set
-    | _ ->
-      let k, char_set = scan_first_pos j in
-      k, Pos_set char_set in
-
-  scan_first_neg j
-;;
-
-(* Char sets are now represented as bit vectors that are represented as
-   byte strings. *)
-
-(* Bit manipulations into bytes. *)
-let set_bit_of_byte byte idx b =
-  (b lsl idx) lor (byte land (* mask idx *) (lnot (1 lsl idx)))
-;;
-
-let get_bit_of_byte byte idx = (byte lsr idx) land 1;;
-
-(* Bit manipulations in vectors of bytes represented as strings. *)
-let set_bit_of_range r c b =
-  let idx = c land 0x7 in
-  let ydx = c lsr 3 in
-  let byte = r.[ydx] in
-  r.[ydx] <- char_of_int (set_bit_of_byte (int_of_char byte) idx b)
-;;
-
-let get_bit_of_range r c =
-  let idx = c land 0x7 in
-  let ydx = c lsr 3 in
-  let byte = r.[ydx] in
-  get_bit_of_byte (int_of_char byte) idx
-;;
-
-(* Char sets represented as bit vectors represented as fixed length byte
-   strings. *)
-(* Create a full or empty set of chars. *)
-let make_range bit =
-  let c = char_of_int (if bit = 0 then 0 else 0xFF) in
-  String.make 32 c
-;;
-
-(* Test if a char belongs to a set of chars. *)
-let get_char_in_range r c = get_bit_of_range r (int_of_char c);;
-
-let bit_not b = (lnot b) land 1;;
-
-(* Build the bit vector corresponding to the set of characters
-   that belongs to the string argument [set].
-   (In the [Scanf] module [set] is always a sub-string of the format.) *)
-let make_char_bit_vect bit set =
-  let r = make_range (bit_not bit) in
-  let lim = String.length set - 1 in
-  let rec loop bit rp i =
-    if i <= lim then
-    match set.[i] with
-    | '-' when rp ->
-      (* 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 = succ i in
-      if i > lim then loop bit false (i - 1) else
-      let c2 = set.[i] in
-      for j = int_of_char c1 to int_of_char c2 do
-        set_bit_of_range r j bit done;
-      loop bit false (succ i)
-    | _ ->
-      set_bit_of_range r (int_of_char set.[i]) bit;
-      loop bit true (succ i) in
-  loop bit false 0;
-  r
-;;
-
-(* Compute the predicate on chars corresponding to a char set. *)
-let make_predicate bit set stp =
-  let r = make_char_bit_vect bit set in
-  List.iter
-    (fun c -> set_bit_of_range r (int_of_char c) (bit_not bit)) stp;
-  (fun c -> get_char_in_range r c)
-;;
-
-let make_setp stp char_set =
-  match char_set with
-  | Pos_set set ->
-    begin match String.length set with
-    | 0 -> (fun _ -> 0)
-    | 1 ->
-      let p = set.[0] in
-      (fun c -> if c == p then 1 else 0)
-    | 2 ->
-      let p1 = set.[0] and p2 = set.[1] in
-      (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_predicate 1 set stp else
-      (fun c -> if c == p1 || c == p2 || c == p3 then 1 else 0)
-    | _ -> make_predicate 1 set stp
-    end
-  | Neg_set set ->
-    begin match String.length set with
-    | 0 -> (fun _ -> 1)
-    | 1 ->
-      let p = set.[0] in
-      (fun c -> if c != p then 1 else 0)
-    | 2 ->
-      let p1 = set.[0] and p2 = set.[1] in
-      (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_predicate 0 set stp else
-      (fun c -> if c != p1 && c != p2 && c != p3 then 1 else 0)
-    | _ -> make_predicate 0 set stp
-    end
-;;
-
-let setp_table = Hashtbl.create 7;;
-
-let add_setp stp char_set setp =
-  let char_set_tbl =
-    try Hashtbl.find setp_table char_set with
-    | Not_found ->
-      let char_set_tbl = Hashtbl.create 3 in
-      Hashtbl.add setp_table char_set char_set_tbl;
-      char_set_tbl in
-  Hashtbl.add char_set_tbl stp setp
-;;
+  scan_string None m ib
 
-let find_setp stp char_set =
-  try Hashtbl.find (Hashtbl.find setp_table char_set) stp with
-  | Not_found ->
-    let setp = make_setp stp char_set in
-    add_setp stp char_set setp;
-    setp
-;;
-
-let scan_chars_in_char_set stp char_set width ib =
-  let rec loop_pos1 cp1 width =
-    if width = 0 then width else
-    let c = Scanning.peek_char ib in
-    if Scanning.eof ib then width else
-    if c == cp1
-    then loop_pos1 cp1 (Scanning.store_char width ib c)
-    else width
-  and loop_pos2 cp1 cp2 width =
-    if width = 0 then width else
-    let c = Scanning.peek_char ib in
-    if Scanning.eof ib then width else
-    if c == cp1 || c == cp2
-    then loop_pos2 cp1 cp2 (Scanning.store_char width ib c)
-    else width
-  and loop_pos3 cp1 cp2 cp3 width =
-    if width = 0 then width else
-    let c = Scanning.peek_char ib in
-    if Scanning.eof ib then width else
-    if c == cp1 || c == cp2 || c == cp3
-    then loop_pos3 cp1 cp2 cp3 (Scanning.store_char width ib c)
-    else width
-  and loop_neg1 cp1 width =
-    if width = 0 then width else
+(* Scan a string containing elements in char_set and terminated by scan_indic
+   if provided. *)
+let scan_chars_in_char_set char_set scan_indic width ib =
+  let rec scan_chars i stp =
     let c = Scanning.peek_char ib in
-    if Scanning.eof ib then width else
-    if c != cp1
-    then loop_neg1 cp1 (Scanning.store_char width ib c)
-    else width
-  and loop_neg2 cp1 cp2 width =
-    if width = 0 then width else
-    let c = Scanning.peek_char ib in
-    if Scanning.eof ib then width else
-    if c != cp1 && c != cp2
-    then loop_neg2 cp1 cp2 (Scanning.store_char width ib c)
-    else width
-  and loop_neg3 cp1 cp2 cp3 width =
-    if width = 0 then width else
-    let c = Scanning.peek_char ib in
-    if Scanning.eof ib then width else
-    if c != cp1 && c != cp2 && c != cp3
-    then loop_neg3 cp1 cp2 cp3 (Scanning.store_char width ib c)
-    else width
-  and loop setp width =
-    if width = 0 then width else
-    let c = Scanning.peek_char ib in
-    if Scanning.eof ib then width else
-    if setp c == 1
-    then loop setp (Scanning.store_char width ib c)
-    else width in
-
-  let width =
-    match char_set with
-    | Pos_set set ->
-      begin match String.length set with
-      | 0 -> loop (fun _ -> 0) width
-      | 1 -> loop_pos1 set.[0] width
-      | 2 -> loop_pos2 set.[0] set.[1] width
-      | 3 when set.[1] != '-' -> loop_pos3 set.[0] set.[1] set.[2] width
-      | _ -> loop (find_setp stp char_set) width end
-    | Neg_set set ->
-      begin match String.length set with
-      | 0 -> loop (fun _ -> 1) width
-      | 1 -> loop_neg1 set.[0] width
-      | 2 -> loop_neg2 set.[0] set.[1] width
-      | 3 when set.[1] != '-' -> loop_neg3 set.[0] set.[1] set.[2] width
-      | _ -> loop (find_setp stp char_set) width end in
-  ignore_stoppers stp ib;
-  width
-;;
-
-let get_count t ib =
-  match t with
-  | 'l' -> Scanning.line_count ib
-  | 'n' -> Scanning.char_count ib
-  | _ -> Scanning.token_count ib
-;;
-
-let rec skip_whites ib =
-  let c = Scanning.peek_char ib in
-  if not (Scanning.eof ib) then begin
-    match c with
-    | ' ' | '\t' | '\n' | '\r' ->
-      Scanning.invalidate_current_char ib; skip_whites ib
-    | _ -> ()
-  end
-;;
+    if i > 0 && not (Scanning.eof ib) && is_in_char_set char_set c &&
+      int_of_char c <> stp then
+      let _ = Scanning.store_char max_int ib c in
+      scan_chars (i - 1) stp;
+  in
+  match scan_indic with
+  | None -> scan_chars width (-1);
+  | Some c ->
+    scan_chars width (int_of_char c);
+    if not (Scanning.eof ib) then
+      let ci = Scanning.peek_char ib in
+      if c = ci then Scanning.invalidate_current_char ib
+      else character_mismatch c ci
 
 (* The global error report function for [Scanf]. *)
 let scanf_bad_input ib = function
   | Scan_failure s | Failure s ->
     let i = Scanning.char_count ib in
-    bad_input (Printf.sprintf "scanf: bad input at char number %i: \'%s\'" i s)
+    bad_input (Printf.sprintf "scanf: bad input at char number %i: %S" i s)
   | x -> raise x
-;;
 
-let list_iter_i f l =
-  let rec loop i = function
-  | [] -> ()
-  | [x] -> f i x (* Tail calling [f] *)
-  | x :: xs -> f i x; loop (succ i) xs in
-  loop 0 l
-;;
+(* Get the content of a counter from an input buffer. *)
+let get_counter ib counter = match counter with
+  | Line_counter -> Scanning.line_count ib
+  | Char_counter -> Scanning.char_count ib
+  | Token_counter -> Scanning.token_count ib
 
-let ascanf sc fmt =
-  let ac = Tformat.ac_of_format fmt in
-  match ac.Tformat.ac_rdrs with
-  | 0 ->
-    Obj.magic (fun f -> sc fmt [||] f)
-  | 1 ->
-    Obj.magic (fun x f -> sc fmt [| Obj.repr x |] f)
-  | 2 ->
-    Obj.magic (fun x y f -> sc fmt [| Obj.repr x; Obj.repr y; |] f)
-  | 3 ->
-    Obj.magic
-      (fun x y z f -> sc fmt [| Obj.repr x; Obj.repr y; Obj.repr z; |] f)
-  | nargs ->
-    let rec loop i args =
-      if i >= nargs then
-        let a = Array.make nargs (Obj.repr 0) in
-        list_iter_i (fun i arg -> a.(nargs - i - 1) <- arg) args;
-        Obj.magic (fun f -> sc fmt a f)
-      else Obj.magic (fun x -> loop (succ i) (x :: args)) in
-    loop 0 []
-;;
-
-(* The [scan_format] main scanning function.
-   It takes as arguments:
-     - an input buffer [ib] from which to read characters,
-     - an error handling function [ef],
-     - a format [fmt] that specifies what to read in the input,
-     - a vector of user's defined readers [rv],
-     - and a function [f] to pass the tokens read to.
-
-   Then [scan_format] scans the format and the input buffer in parallel to
-   find out tokens as specified by the format; when it finds one token, it
-   converts it as specified, remembers the converted value as a future
-   argument to the function [f], and continues scanning.
-
-   If the entire scanning succeeds (i.e. the format string has been
-   exhausted and the buffer has provided tokens according to the
-   format string), [f] is applied to the tokens read.
-
-   If the scanning or some conversion fails, the main scanning function
-   aborts and applies the scanning buffer and a string that explains
-   the error to the error handling function [ef] (the error continuation). *)
-
-let scan_format ib ef fmt rv f =
-
-  let limr = Array.length rv - 1 in
-
-  let return v = Obj.magic v () in
-  let delay f x () = f x in
-  let stack f = delay (return f) in
-  let no_stack f _x = f in
-
-  let rec scan fmt =
-
-    let lim = Sformat.length fmt - 1 in
-
-    let rec scan_fmt ir f i =
-      if i > lim then ir, f else
-      match Sformat.unsafe_get fmt i with
-      | '%' -> scan_skip ir f (succ i)
-      | ' ' -> skip_whites ib; scan_fmt ir f (succ i)
-      | c -> check_char ib c; scan_fmt ir f (succ i)
-
-    and scan_skip ir f i =
-      if i > lim then ir, f else
-      match Sformat.get fmt i with
-      | '_' -> scan_limits true ir f (succ i)
-      | _ -> scan_limits false ir f i
-
-    and scan_limits skip ir f i =
-
-      let rec scan_width i =
-        if i > lim then incomplete_format fmt else
-        match Sformat.get fmt i with
-        | '0' .. '9' as conv ->
-          let width, i =
-            read_int_literal (decimal_value_of_char conv) (succ i) in
-          Some width, i
-        | _ -> None, i
-
-      and scan_precision i =
-        begin
-          match Sformat.get fmt i with
-          | '.' ->
-            let precision, i = read_int_literal 0 (succ i) in
-            (Some precision, i)
-          | _ -> None, i
-        end
+(* Compute the width of a padding option (see "%42{" and "%123("). *)
+let width_of_pad_opt pad_opt = match pad_opt with
+  | None -> max_int
+  | Some width -> width
 
-      and read_int_literal accu i =
-        if i > lim then accu, i else
-        match Sformat.unsafe_get fmt i with
-        | '0' .. '9' as c ->
-          let accu = 10 * accu + decimal_value_of_char c in
-          read_int_literal accu (succ i)
-        | _ -> accu, i in
-
-      if i > lim then ir, f else
-      let width_opt, i = scan_width i in
-      let prec_opt, i = scan_precision i in
-      scan_conversion skip width_opt prec_opt ir f i
-
-    and scan_conversion skip width_opt prec_opt ir f i =
-      let stack = if skip then no_stack else stack in
-      let width = int_of_width_opt width_opt in
-      let prec = int_of_prec_opt prec_opt in
-      match Sformat.get fmt i with
-      | '%' | '@' as c ->
-        check_char ib c;
-        scan_fmt ir f (succ i)
-      | '!' ->
-        if not (Scanning.end_of_input ib)
-        then bad_input "end of input not found" else
-        scan_fmt ir f (succ i)
-      | ',' ->
-        scan_fmt ir f (succ i)
-      | 's' ->
-        let i, stp = scan_indication (succ i) in
-        let _x = scan_string stp width ib in
-        scan_fmt ir (stack f (token_string ib)) (succ i)
-      | 'S' ->
-        let _x = scan_String width ib in
-        scan_fmt ir (stack f (token_string ib)) (succ i)
-      | '[' (* ']' *) ->
-        let i, char_set = scan_range fmt (succ i) in
-        let i, stp = scan_indication (succ i) in
-        let _x = scan_chars_in_char_set stp char_set width ib in
-        scan_fmt ir (stack f (token_string ib)) (succ i)
-      | ('c' | 'C') when width = 0 ->
-        let c = Scanning.checked_peek_char ib in
-        scan_fmt ir (stack f c) (succ i)
-      | 'c' ->
-        let _x = scan_char width ib in
-        scan_fmt ir (stack f (token_char ib)) (succ i)
-      | 'C' ->
-        let _x = scan_Char width ib in
-        scan_fmt ir (stack f (token_char ib)) (succ i)
-      | 'd' | 'i' | 'o' | 'u' | 'x' | 'X' as conv ->
-        let _x = scan_int_conv conv width prec ib in
-        scan_fmt ir (stack f (token_int conv ib)) (succ i)
-      | 'N' as conv ->
-        scan_fmt ir (stack f (get_count conv ib)) (succ i)
-      | 'f' | 'e' | 'E' | 'g' | 'G' ->
-        let _x = scan_float width prec ib in
-        scan_fmt ir (stack f (token_float ib)) (succ i)
-      | 'F' ->
-        let _x = scan_Float width prec ib in
-        scan_fmt ir (stack f (token_float ib)) (succ i)
-(*      | 'B' | 'b' when width = Some 0 ->
-        let _x = scan_bool width ib in
-        scan_fmt ir (stack f (token_int ib)) (succ i) *)
-      | 'B' | 'b' ->
-        let _x = scan_bool width ib in
-        scan_fmt ir (stack f (token_bool ib)) (succ i)
-      | 'r' ->
-        if ir > limr then assert false else
-        let token = Obj.magic rv.(ir) ib in
-        scan_fmt (succ ir) (stack f token) (succ i)
-      | 'l' | 'n' | 'L' as conv0 ->
-        let i = succ i in
-        if i > lim then scan_fmt ir (stack f (get_count conv0 ib)) i else begin
-        match Sformat.get fmt i with
-        (* This is in fact an integer conversion (e.g. %ld, %ni, or %Lo). *)
-        | 'd' | 'i' | 'o' | 'u' | 'x' | 'X' as conv1 ->
-          let _x = scan_int_conv conv1 width prec ib in
-          (* Look back to the character that triggered the integer conversion
-             (this character is either 'l', 'n' or 'L') to find the
-             conversion to apply to the integer token read. *)
-          begin match conv0 with
-          | 'l' -> scan_fmt ir (stack f (token_int32 conv1 ib)) (succ i)
-          | 'n' -> scan_fmt ir (stack f (token_nativeint conv1 ib)) (succ i)
-          | _ -> scan_fmt ir (stack f (token_int64 conv1 ib)) (succ i) end
-        (* This is not an integer conversion, but a regular %l, %n or %L. *)
-        | _ -> scan_fmt ir (stack f (get_count conv0 ib)) i end
-      | '(' | '{' as conv (* ')' '}' *) ->
-        let i = succ i in
-        (* Find [mf], the static specification for the format to read. *)
-        let j =
-          Tformat.sub_format
-            incomplete_format bad_conversion conv fmt i in
-        let mf = Sformat.sub fmt (Sformat.index_of_int i) (j - 2 - i) in
-        (* Read [rf], the specified format string in the input buffer,
-           and check its correctness w.r.t. [mf]. *)
-        let _x = scan_String width ib in
-        let rf = token_string ib in
-        if not (compatible_format_type rf mf) then format_mismatch rf mf else
-        (* Proceed according to the kind of metaformat found:
-           - %{ mf %} simply returns [rf] as the token read,
-           - %( mf %) returns [rf] as the first token read, then
-             returns a second token obtained by scanning the input with
-             format string [rf].
-           Behaviour for %( mf %) is mandatory for sake of format string
-           typechecking specification. To get pure format string
-           substitution behaviour, you should use %_( mf %) that skips the
-           first (format string) token and hence properly substitutes [mf] by
-           [rf] in the format string argument.
+let stopper_of_formatting_lit fmting =
+  if fmting = Escaped_percent then '%', "" else
+    let str = string_of_formatting_lit fmting in
+    let stp = str.[1] in
+    let sub_str = String.sub str 2 (String.length str - 2) in
+    stp, sub_str
+
+(******************************************************************************)
+                           (* Readers managment *)
+
+(* A call to take_format_readers on a format is evaluated into functions
+   taking readers as arguments and aggregate them into an heterogeneous list *)
+(* When all readers are taken, finally pass the list of the readers to the
+   continuation k. *)
+let rec take_format_readers : type a c d e f .
+    ((d, e) heter_list -> e) -> (a, Scanning.in_channel, c, d, e, f) fmt ->
+    d =
+fun k fmt -> match fmt with
+  | Reader fmt_rest ->
+    fun reader ->
+      let new_k readers_rest = k (Cons (reader, readers_rest)) in
+      take_format_readers new_k fmt_rest
+  | Char rest                        -> take_format_readers k rest
+  | Caml_char rest                   -> take_format_readers k rest
+  | String (_, rest)                 -> take_format_readers k rest
+  | Caml_string (_, rest)            -> take_format_readers k rest
+  | Int (_, _, _, rest)              -> take_format_readers k rest
+  | Int32 (_, _, _, rest)            -> take_format_readers k rest
+  | Nativeint (_, _, _, rest)        -> take_format_readers k rest
+  | Int64 (_, _, _, rest)            -> take_format_readers k rest
+  | Float (_, _, _, rest)            -> take_format_readers k rest
+  | Bool rest                        -> take_format_readers k rest
+  | Alpha rest                       -> take_format_readers k rest
+  | Theta rest                       -> take_format_readers k rest
+  | Flush rest                       -> take_format_readers k rest
+  | String_literal (_, rest)         -> take_format_readers k rest
+  | Char_literal (_, rest)           -> take_format_readers k rest
+
+  | Scan_char_set (_, _, rest)       -> take_format_readers k rest
+  | Scan_get_counter (_, rest)       -> take_format_readers k rest
+
+  | Formatting_lit (_, rest)         -> take_format_readers k rest
+  | Formatting_gen (Open_tag (Format (fmt, _)), rest) -> take_format_readers k (concat_fmt fmt rest)
+  | Formatting_gen (Open_box (Format (fmt, _)), rest) -> take_format_readers k (concat_fmt fmt rest)
+
+  | Format_arg (_, _, rest)          -> take_format_readers k rest
+  | Format_subst (_, fmtty, rest)    -> take_fmtty_format_readers k (erase_rel (symm fmtty)) rest
+  | Ignored_param (ign, rest)        -> take_ignored_format_readers k ign rest
+
+  | End_of_format                    -> k Nil
+
+(* Take readers associated to an fmtty coming from a Format_subst "%(...%)". *)
+and take_fmtty_format_readers : type x y a c d e f .
+    ((d, e) heter_list -> e) -> (a, Scanning.in_channel, c, d, x, y) fmtty ->
+      (y, Scanning.in_channel, c, x, e, f) fmt -> d =
+fun k fmtty fmt -> match fmtty with
+  | Reader_ty fmt_rest ->
+    fun reader ->
+      let new_k readers_rest = k (Cons (reader, readers_rest)) in
+      take_fmtty_format_readers new_k fmt_rest fmt
+  | Ignored_reader_ty fmt_rest ->
+    fun reader ->
+      let new_k readers_rest = k (Cons (reader, readers_rest)) in
+      take_fmtty_format_readers new_k fmt_rest fmt
+  | Char_ty rest                -> take_fmtty_format_readers k rest fmt
+  | String_ty rest              -> take_fmtty_format_readers k rest fmt
+  | Int_ty rest                 -> take_fmtty_format_readers k rest fmt
+  | Int32_ty rest               -> take_fmtty_format_readers k rest fmt
+  | Nativeint_ty rest           -> take_fmtty_format_readers k rest fmt
+  | Int64_ty rest               -> take_fmtty_format_readers k rest fmt
+  | Float_ty rest               -> take_fmtty_format_readers k rest fmt
+  | Bool_ty rest                -> take_fmtty_format_readers k rest fmt
+  | Alpha_ty rest               -> take_fmtty_format_readers k rest fmt
+  | Theta_ty rest               -> take_fmtty_format_readers k rest fmt
+  | Format_arg_ty (_, rest)     -> take_fmtty_format_readers k rest fmt
+  | End_of_fmtty                -> take_format_readers k fmt
+  | Format_subst_ty (ty1, ty2, rest) ->
+    let ty = trans (symm ty1) ty2 in
+    take_fmtty_format_readers k (concat_fmtty ty rest) fmt
+
+(* Take readers associated to an ignored parameter. *)
+and take_ignored_format_readers : type x y a c d e f .
+    ((d, e) heter_list -> e) -> (a, Scanning.in_channel, c, d, x, y) ignored ->
+      (y, Scanning.in_channel, c, x, e, f) fmt -> d =
+fun k ign fmt -> match ign with
+  | Ignored_reader ->
+    fun reader ->
+      let new_k readers_rest = k (Cons (reader, readers_rest)) in
+      take_format_readers new_k fmt
+  | Ignored_char                    -> take_format_readers k fmt
+  | Ignored_caml_char               -> take_format_readers k fmt
+  | Ignored_string _                -> take_format_readers k fmt
+  | Ignored_caml_string _           -> take_format_readers k fmt
+  | Ignored_int (_, _)              -> take_format_readers k fmt
+  | Ignored_int32 (_, _)            -> take_format_readers k fmt
+  | Ignored_nativeint (_, _)        -> take_format_readers k fmt
+  | Ignored_int64 (_, _)            -> take_format_readers k fmt
+  | Ignored_float (_, _)            -> take_format_readers k fmt
+  | Ignored_bool                    -> take_format_readers k fmt
+  | Ignored_format_arg _            -> take_format_readers k fmt
+  | Ignored_format_subst (_, fmtty) -> take_fmtty_format_readers k fmtty fmt
+  | Ignored_scan_char_set _         -> take_format_readers k fmt
+  | Ignored_scan_get_counter _      -> take_format_readers k fmt
+
+(******************************************************************************)
+                          (* Generic scanning *)
+
+(* Make a generic scanning function. *)
+(* Scan a stream according to a format and readers obtained by
+   take_format_readers, and aggegate scanned values into an
+   heterogeneous list. *)
+(* Return the heterogeneous list of scanned values. *)
+let rec make_scanf : type a c d e f .
+    Scanning.in_channel -> (a, Scanning.in_channel, c, d, e, f) fmt ->
+      (d, _) heter_list -> (a, f) heter_list =
+fun ib fmt readers -> match fmt with
+  | Char rest ->
+    let _ = scan_char 0 ib in
+    let c = token_char ib in
+    Cons (c, make_scanf ib rest readers)
+  | Caml_char rest ->
+    let _ = scan_caml_char 0 ib in
+    let c = token_char ib in
+    Cons (c, make_scanf ib rest readers)
+
+  | String (pad, Formatting_lit (fmting_lit, rest)) ->
+    let stp, str = stopper_of_formatting_lit fmting_lit in
+    let scan width _ ib = scan_string (Some stp) width ib in
+    let str_rest = String_literal (str, rest) in
+    pad_prec_scanf ib str_rest readers pad No_precision scan token_string
+  | String (pad, rest) ->
+    let scan width _ ib = scan_string None width ib in
+    pad_prec_scanf ib rest readers pad No_precision scan token_string
+
+  | Caml_string (pad, rest) ->
+    let scan width _ ib = scan_caml_string width ib in
+    pad_prec_scanf ib rest readers pad No_precision scan token_string
+  | Int (iconv, pad, prec, rest) ->
+    let c = char_of_iconv iconv in
+    let scan width _ ib = scan_int_conv c width ib in
+    pad_prec_scanf ib rest readers pad prec scan (token_int c)
+  | Int32 (iconv, pad, prec, rest) ->
+    let c = char_of_iconv iconv in
+    let scan width _ ib = scan_int_conv c width ib in
+    pad_prec_scanf ib rest readers pad prec scan (token_int32 c)
+  | Nativeint (iconv, pad, prec, rest) ->
+    let c = char_of_iconv iconv in
+    let scan width _ ib = scan_int_conv c width ib in
+    pad_prec_scanf ib rest readers pad prec scan (token_nativeint c)
+  | Int64 (iconv, pad, prec, rest) ->
+    let c = char_of_iconv iconv in
+    let scan width _ ib = scan_int_conv c width ib in
+    pad_prec_scanf ib rest readers pad prec scan (token_int64 c)
+  | Float (Float_F, pad, prec, rest) ->
+    pad_prec_scanf ib rest readers pad prec scan_caml_float token_float
+  | Float ((Float_f | Float_pf | Float_sf | Float_e | Float_pe | Float_se
+               | Float_E | Float_pE | Float_sE | Float_g | Float_pg | Float_sg
+               | Float_G | Float_pG | Float_sG), pad, prec, rest) ->
+    pad_prec_scanf ib rest readers pad prec scan_float token_float
+
+  | Bool rest ->
+    let _ = scan_bool ib in
+    let b = token_bool ib in
+    Cons (b, make_scanf ib rest readers)
+  | Alpha _ ->
+    invalid_arg "scanf: bad conversion \"%a\""
+  | Theta _ ->
+    invalid_arg "scanf: bad conversion \"%t\""
+  | Reader fmt_rest ->
+    let Cons (reader, readers_rest) = readers in
+    let x = reader ib in
+    Cons (x, make_scanf ib fmt_rest readers_rest)
+  | Flush rest ->
+    if Scanning.end_of_input ib then make_scanf ib rest readers
+    else bad_input "end of input not found"
+
+  | String_literal (str, rest) ->
+    String.iter (check_char ib) str;
+    make_scanf ib rest readers
+  | Char_literal (chr, rest) ->
+    check_char ib chr;
+    make_scanf ib rest readers
+
+  | Format_arg (pad_opt, fmtty, rest) ->
+    let _ = scan_caml_string (width_of_pad_opt pad_opt) ib in
+    let s = token_string ib in
+    let fmt =
+      try format_of_string_fmtty s fmtty
+      with Failure msg -> bad_input msg
+    in
+    Cons (fmt, make_scanf ib rest readers)
+  | Format_subst (pad_opt, fmtty, rest) ->
+    let _ = scan_caml_string (width_of_pad_opt pad_opt) ib in
+    let s = token_string ib in
+    let fmt, fmt' =
+      try
+        let Fmt_EBB fmt = fmt_ebb_of_string s in
+        let Fmt_EBB fmt' = fmt_ebb_of_string s in
+        (* TODO: find a way to avoid reparsing twice *)
+
+        (* TODO: these type-checks below *can* fail because of type
+           ambiguity in presence of ignored-readers: "%_r%d" and "%d%_r"
+           are typed in the same way.
+
+           # Scanf.sscanf "\"%_r%d\"3" "%(%d%_r%)" ignore
+             (fun fmt n -> string_of_format fmt, n);;
+           Exception: CamlinternalFormat.Type_mismatch.
+
+           We should properly catch this exception.
         *)
-        (* For conversion %{%}, just return this format string as the token
-           read and go on with the rest of the format string argument. *)
-        if conv = '{' (* '}' *) then scan_fmt ir (stack f rf) j else
-        (* Or else, return this format string as the first token read;
-           then continue scanning using this format string to get
-           the following token read;
-           finally go on with the rest of the format string argument. *)
-        let ir, nf = scan (string_to_format rf) ir (stack f rf) 0 in
-        (* Return the format string read and the value just read,
-           then go on with the rest of the format. *)
-        scan_fmt ir nf j
-
-      | c -> bad_conversion fmt i c
-
-    and scan_indication j =
-      if j > lim then j - 1, [] else
-      match Sformat.get fmt j with
-      | '@' ->
-        let k = j + 1 in
-        if k > lim then j - 1, [] else
-        begin match Sformat.get fmt k with
-        | '%' ->
-          let k = k + 1 in
-          if k > lim then j - 1, [] else
-          begin match Sformat.get fmt k with
-          | '%' | '@' as c  -> k, [ c ]
-          | _c -> j - 1, []
-          end
-        | c -> k, [ c ]
-        end
-      | _c -> j - 1, [] in
-
-    scan_fmt in
-
-
-  Scanning.reset_token ib;
-
-  let v =
-    try snd (scan fmt 0 (fun () -> f) 0) with
-    | (Scan_failure _ | Failure _ | End_of_file) as exc ->
-      stack (delay ef ib) exc in
-  return v
-;;
-
-let mkscanf ib ef fmt =
-  let sc = scan_format ib ef in
-  ascanf sc fmt
-;;
-
-let kscanf ib ef fmt = mkscanf ib ef fmt;;
-
-let bscanf ib = kscanf ib scanf_bad_input;;
-
-let fscanf ic = bscanf (Scanning.from_channel ic);;
-
-let sscanf : string -> ('a, 'b, 'c, 'd) scanner
-  = fun s -> bscanf (Scanning.from_string s);;
-
-let scanf fmt = bscanf Scanning.stdib fmt;;
-
-let bscanf_format ib fmt f =
-  let fmt = Sformat.unsafe_to_string fmt in
-  let fmt1 =
-    ignore (scan_String max_int ib);
-    token_string ib in
-  if not (compatible_format_type fmt1 fmt) then
-    format_mismatch fmt1 fmt else
-  f (string_to_format fmt1)
-;;
+        type_format fmt (erase_rel fmtty),
+        type_format fmt' (erase_rel (symm fmtty))
+      with Failure msg -> bad_input msg
+    in
+    Cons (Format (fmt, s),
+          make_scanf ib (concat_fmt fmt' rest) readers)
+
+  | Scan_char_set (width_opt, char_set, Formatting_lit (fmting_lit, rest)) ->
+    let stp, str = stopper_of_formatting_lit fmting_lit in
+    let width = width_of_pad_opt width_opt in
+    let _ = scan_chars_in_char_set char_set (Some stp) width ib in
+    let s = token_string ib in
+    let str_rest = String_literal (str, rest) in
+    Cons (s, make_scanf ib str_rest readers)
+  | Scan_char_set (width_opt, char_set, rest) ->
+    let width = width_of_pad_opt width_opt in
+    let _ = scan_chars_in_char_set char_set None width ib in
+    let s = token_string ib in
+    Cons (s, make_scanf ib rest readers)
+  | Scan_get_counter (counter, rest) ->
+    let count = get_counter ib counter in
+    Cons (count, make_scanf ib rest readers)
+
+  | Formatting_lit (formatting_lit, rest) ->
+    String.iter (check_char ib) (string_of_formatting_lit formatting_lit);
+    make_scanf ib rest readers
+  | Formatting_gen (Open_tag (Format (fmt', _)), rest) ->
+    check_char ib '@'; check_char ib '{';
+    make_scanf ib (concat_fmt fmt' rest) readers
+  | Formatting_gen (Open_box (Format (fmt', _)), rest) ->
+    check_char ib '@'; check_char ib '[';
+    make_scanf ib (concat_fmt fmt' rest) readers
+
+  | Ignored_param (ign, rest) ->
+    let Param_format_EBB fmt' = param_format_of_ignored_format ign rest in
+    begin match make_scanf ib fmt' readers with
+    | Cons (_, arg_rest) -> arg_rest
+    | Nil -> assert false
+    end
 
-let sscanf_format s fmt = bscanf_format (Scanning.from_string s) fmt;;
+  | End_of_format ->
+    Nil
+
+(* Case analysis on padding and precision. *)
+(* Reject formats containing "%*" or "%.*". *)
+(* Pass padding and precision to the generic scanner `scan'. *)
+and pad_prec_scanf : type a c d e f x y z t .
+    Scanning.in_channel -> (a, Scanning.in_channel, c, d, e, f) fmt ->
+      (d, _) heter_list -> (x, y) padding -> (y, z -> a) precision ->
+      (int -> int -> Scanning.in_channel -> t) ->
+      (Scanning.in_channel -> z) ->
+      (x, f) heter_list =
+fun ib fmt readers pad prec scan token -> match pad, prec with
+  | No_padding, No_precision ->
+    let _ = scan max_int max_int ib in
+    let x = token ib in
+    Cons (x, make_scanf ib fmt readers)
+  | No_padding, Lit_precision p ->
+    let _ = scan max_int p ib in
+    let x = token ib in
+    Cons (x, make_scanf ib fmt readers)
+  | Lit_padding ((Right | Zeros), w), No_precision ->
+    let _ = scan w max_int ib in
+    let x = token ib in
+    Cons (x, make_scanf ib fmt readers)
+  | Lit_padding ((Right | Zeros), w), Lit_precision p ->
+    let _ = scan w p ib in
+    let x = token ib in
+    Cons (x, make_scanf ib fmt readers)
+  | Lit_padding (Left, _), _ ->
+    invalid_arg "scanf: bad conversion \"%-\""
+  | Lit_padding ((Right | Zeros), _), Arg_precision ->
+    invalid_arg "scanf: bad conversion \"%*\""
+  | Arg_padding _, _ ->
+    invalid_arg "scanf: bad conversion \"%*\""
+  | No_padding, Arg_precision ->
+    invalid_arg "scanf: bad conversion \"%*\""
+
+(******************************************************************************)
+            (* Defining [scanf] and various flavors of [scanf] *)
+
+type 'a kscanf_result = Args of 'a | Exc of exn
+
+let kscanf ib ef (Format (fmt, str)) =
+  let rec apply : type a b . a -> (a, b) heter_list -> b =
+    fun f args -> match args with
+    | Cons (x, r) -> apply (f x) r
+    | Nil -> f
+  in
+  let k readers f =
+    Scanning.reset_token ib;
+    match try Args (make_scanf ib fmt readers) with
+      | (Scan_failure _ | Failure _ | End_of_file) as exc -> Exc exc
+      | Invalid_argument msg ->
+        invalid_arg (msg ^ " in format \"" ^ String.escaped str ^ "\"")
+    with
+      | Args args -> apply f args
+      | Exc exc -> ef ib exc
+  in
+  take_format_readers k fmt
+
+let kbscanf = kscanf
+
+(***)
+
+let ksscanf s ef fmt = kbscanf (Scanning.from_string s) ef fmt
+let kfscanf ic ef fmt = kbscanf (Scanning.from_channel ic) ef fmt
+let bscanf ib fmt = kscanf ib scanf_bad_input fmt
+let fscanf ic fmt = kscanf (Scanning.from_channel ic) scanf_bad_input fmt
+let sscanf s fmt = kscanf (Scanning.from_string s) scanf_bad_input fmt
+let scanf fmt = kscanf Scanning.stdib scanf_bad_input fmt
+
+(***)
+
+let bscanf_format : Scanning.in_channel -> ('a, 'b, 'c, 'd, 'e, 'f) format6 ->
+  (('a, 'b, 'c, 'd, 'e, 'f) format6 -> 'g) -> 'g =
+  fun ib format f ->
+    let _ = scan_caml_string max_int ib in
+    let str = token_string ib in
+    let fmt' =
+      try format_of_string_format str format
+      with Failure msg -> bad_input msg
+    in
+    f fmt'
+
+let sscanf_format : string -> ('a, 'b, 'c, 'd, 'e, 'f) format6 ->
+  (('a, 'b, 'c, 'd, 'e, 'f) format6 -> 'g) -> 'g =
+  fun s format f -> bscanf_format (Scanning.from_string s) format f
 
 let string_to_String s =
   let l = String.length s in
@@ -1566,9 +1351,3 @@ let format_from_string s fmt =
 let unescaped s =
   sscanf ("\"" ^ s ^ "\"") "%S%!" (fun x -> x)
 ;;
-
-(*
- Local Variables:
-  compile-command: "cd ..; make world"
-  End:
-*)
diff --git a/stdlib/scanf.mli b/stdlib/scanf.mli
index a1b3d1acbf..297d6f2d5a 100644
--- a/stdlib/scanf.mli
+++ b/stdlib/scanf.mli
@@ -485,6 +485,16 @@ val kscanf :
     exception that aborted the scanning process as arguments.
 *)
 
+val ksscanf :
+  string -> (Scanning.in_channel -> exn -> 'd) ->
+    ('a, 'b, 'c, 'd) scanner
+(** Same as {!Scanf.kscanf} but reads from the given string. *)
+
+val kfscanf :
+  Pervasives.in_channel -> (Scanning.in_channel -> exn -> 'd) ->
+    ('a, 'b, 'c, 'd) scanner
+(** Same as {!Scanf.kscanf}, but reads from the given regular input channel. *)
+
 (** {6 Reading format strings from input} *)
 
 val bscanf_format :
diff --git a/stdlib/set.mli b/stdlib/set.mli
index 556ee9388e..1b67398eef 100644
--- a/stdlib/set.mli
+++ b/stdlib/set.mli
@@ -19,6 +19,27 @@
    The implementation uses balanced binary trees, and is therefore
    reasonably efficient: insertion and membership take time
    logarithmic in the size of the set, for instance.
+
+   The [Make] functor constructs implementations for any type, given a
+   [compare] function.
+   For instance:
+   {[
+     module IntPairs =
+       struct
+         type t = int * int
+         let compare (x0,y0) (x1,y1) =
+           match Pervasives.compare x0 x1 with
+               0 -> Pervasives.compare y0 y1
+             | c -> c
+       end
+
+     module PairsSet = Set.Make(IntPairs)
+
+     let m = PairsSet.(empty |> add (2,3) |> add (5,7) |> add (11,13))
+   ]}
+
+   This creates a new module [PairsSet], with a new type [PairsSet.t]
+   of sets of [int * int].
 *)
 
 module type OrderedType =
diff --git a/stdlib/stdLabels.ml b/stdlib/stdLabels.ml
index 35b25e0b71..60713ca0cd 100644
--- a/stdlib/stdLabels.ml
+++ b/stdlib/stdLabels.ml
@@ -18,3 +18,5 @@ module Array = ArrayLabels
 module List = ListLabels
 
 module String = StringLabels
+
+module Bytes = BytesLabels
diff --git a/stdlib/stdLabels.mli b/stdlib/stdLabels.mli
index 144936f170..c607a9987d 100644
--- a/stdlib/stdLabels.mli
+++ b/stdlib/stdLabels.mli
@@ -14,12 +14,14 @@
 (** Standard labeled libraries.
 
    This meta-module provides labelized version of the {!Array},
-   {!List} and {!String} modules.
+   {!Bytes}, {!List} and {!String} modules.
 
    They only differ by their labels. Detailed interfaces can be found
-   in [arrayLabels.mli], [listLabels.mli] and [stringLabels.mli].
+   in [arrayLabels.mli], [bytesLabels.mli], [listLabels.mli]
+   and [stringLabels.mli].
 *)
 
 module Array = ArrayLabels
+module Bytes = BytesLabels
 module List = ListLabels
 module String = StringLabels
diff --git a/stdlib/stream.ml b/stdlib/stream.ml
index 753bce0056..751c741a85 100644
--- a/stdlib/stream.ml
+++ b/stdlib/stream.ml
@@ -25,7 +25,7 @@ and 'a data =
   | Sbuffio of buffio
 and 'a gen = { mutable curr : 'a option option; func : int -> 'a option }
 and buffio =
-  { ic : in_channel; buff : string; mutable len : int; mutable ind : int }
+  { ic : in_channel; buff : bytes; mutable len : int; mutable ind : int }
 ;;
 exception Failure;;
 exception Error of string;;
@@ -37,7 +37,7 @@ let set_data (s : 'a t) (d : 'a data) =
 ;;
 
 let fill_buff b =
-  b.len <- input b.ic b.buff 0 (String.length b.buff); b.ind <- 0
+  b.len <- input b.ic b.buff 0 (Bytes.length b.buff); b.ind <- 0
 ;;
 
 let rec get_data count d = match d with
@@ -64,7 +64,7 @@ let rec get_data count d = match d with
  | Sbuffio b ->
      if b.ind >= b.len then fill_buff b;
      if b.len == 0 then Sempty else
-       let r = Obj.magic (String.unsafe_get b.buff b.ind) in
+       let r = Obj.magic (Bytes.unsafe_get b.buff b.ind) in
        (* Warning: anyone using g thinks that an item has been read *)
        b.ind <- succ b.ind; Scons(r, d)
  | Slazy f -> get_data count (Lazy.force f)
@@ -87,7 +87,7 @@ let rec peek s =
  | Sbuffio b ->
      if b.ind >= b.len then fill_buff b;
      if b.len == 0 then begin set_data s Sempty; None end
-     else Some (Obj.magic (String.unsafe_get b.buff b.ind))
+     else Some (Obj.magic (Bytes.unsafe_get b.buff b.ind))
 ;;
 
 let rec junk s =
@@ -159,9 +159,18 @@ let of_string s =
     else None)
 ;;
 
+let of_bytes s =
+  let count = ref 0 in
+  from (fun _ ->
+    let c = !count in
+    if c < Bytes.length s
+    then (incr count; Some (Bytes.get s c))
+    else None)
+;;
+
 let of_channel ic =
   {count = 0;
-   data = Sbuffio {ic = ic; buff = String.create 4096; len = 0; ind = 0}}
+   data = Sbuffio {ic = ic; buff = Bytes.create 4096; len = 0; ind = 0}}
 ;;
 
 (* Stream expressions builders *)
diff --git a/stdlib/stream.mli b/stdlib/stream.mli
index aeb0da1e87..85a846102c 100644
--- a/stdlib/stream.mli
+++ b/stdlib/stream.mli
@@ -46,6 +46,9 @@ val of_list : 'a list -> 'a t
 val of_string : string -> char t
 (** Return the stream of the characters of the string parameter. *)
 
+val of_bytes : bytes -> char t
+(** Return the stream of the characters of the bytes parameter. *)
+
 val of_channel : in_channel -> char t
 (** Return the stream of the characters read from the input channel. *)
 
diff --git a/stdlib/string.ml b/stdlib/string.ml
index fda40b5279..00ff8be9e7 100644
--- a/stdlib/string.ml
+++ b/stdlib/string.ml
@@ -2,72 +2,53 @@
 (*                                                                     *)
 (*                                OCaml                                *)
 (*                                                                     *)
-(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*          Damien Doligez, projet Gallium, INRIA Rocquencourt         *)
 (*                                                                     *)
-(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  Copyright 2014 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.     *)
 (*                                                                     *)
 (***********************************************************************)
 
-(* String operations *)
+(* String operations, based on byte sequence operations *)
 
 external length : string -> int = "%string_length"
 external get : string -> int -> char = "%string_safe_get"
-external set : string -> int -> char -> unit = "%string_safe_set"
-external create : int -> string = "caml_create_string"
+external set : bytes -> int -> char -> unit = "%string_safe_set"
+external create : int -> bytes = "caml_create_string"
 external unsafe_get : string -> int -> char = "%string_unsafe_get"
-external unsafe_set : string -> int -> char -> unit = "%string_unsafe_set"
-external unsafe_blit : string -> int -> string -> int -> int -> unit
+external unsafe_set : bytes -> int -> char -> unit = "%string_unsafe_set"
+external unsafe_blit : string -> int ->  bytes -> int -> int -> unit
                      = "caml_blit_string" "noalloc"
-external unsafe_fill : string -> int -> int -> char -> unit
+external unsafe_fill : bytes -> int -> int -> char -> unit
                      = "caml_fill_string" "noalloc"
 
-let make n c =
-  let s = create n in
-  unsafe_fill s 0 n c;
-  s
+module B = Bytes
 
-let copy s =
-  let len = length s in
-  let r = create len in
-  unsafe_blit s 0 r 0 len;
-  r
+let bts = B.unsafe_to_string
+let bos = B.unsafe_of_string
 
+let make n c =
+  B.make n c |> bts
+let init n f =
+  B.init n f |> bts
+let copy s =
+  B.copy (bos s) |> bts
 let sub s ofs len =
-  if ofs < 0 || len < 0 || ofs > length s - len
-  then invalid_arg "String.sub"
-  else begin
-    let r = create len in
-    unsafe_blit s ofs r 0 len;
-    r
-  end
-
-let fill s ofs len c =
-  if ofs < 0 || len < 0 || ofs > length s - len
-  then invalid_arg "String.fill"
-  else unsafe_fill s ofs len c
-
+  B.sub (bos s) ofs len |> bts
+let fill =
+  B.fill
 let blit s1 ofs1 s2 ofs2 len =
-  if len < 0 || ofs1 < 0 || ofs1 > length s1 - len
-             || ofs2 < 0 || ofs2 > length s2 - len
-  then invalid_arg "String.blit"
-  else unsafe_blit s1 ofs1 s2 ofs2 len
-
-let iter f a =
-  for i = 0 to length a - 1 do f(unsafe_get a i) done
-
-let iteri f a =
-  for i = 0 to length a - 1 do f i (unsafe_get a i) done
+  B.blit (bos s1) ofs1 s2 ofs2 len
 
 let concat sep l =
   match l with
-    [] -> ""
+  | [] -> ""
   | hd :: tl ->
       let num = ref 0 and len = ref 0 in
       List.iter (fun s -> incr num; len := !len + length s) l;
-      let r = create (!len + length sep * (!num - 1)) in
+      let r = B.create (!len + length sep * (!num - 1)) in
       unsafe_blit hd 0 r 0 (length hd);
       let pos = ref(length hd) in
       List.iter
@@ -77,128 +58,68 @@ let concat sep l =
           unsafe_blit s 0 r !pos (length s);
           pos := !pos + length s)
         tl;
-      r
+      Bytes.unsafe_to_string r
+
+let iter f s =
+  B.iter f (bos s)
+let iteri f s =
+  B.iteri f (bos s)
+let map f s =
+  B.map f (bos s) |> bts
+let mapi f s =
+  B.mapi f (bos s) |> bts
+
+(* Beware: we cannot use B.trim or B.escape because they always make a
+   copy, but String.mli spells out some cases where we are not allowed
+   to make a copy. *)
 
 external is_printable: char -> bool = "caml_is_printable"
-external char_code: char -> int = "%identity"
-external char_chr: int -> char = "%identity"
 
 let is_space = function
   | ' ' | '\012' | '\n' | '\r' | '\t' -> true
   | _ -> false
 
 let trim s =
-  let len = length s in
-  let i = ref 0 in
-  while !i < len && is_space (unsafe_get s !i) do
-    incr i
-  done;
-  let j = ref (len - 1) in
-  while !j >= !i && is_space (unsafe_get s !j) do
-    decr j
-  done;
-  if !i = 0 && !j = len - 1 then
-    s
-  else if !j >= !i then
-    sub s !i (!j - !i + 1)
-  else
-    ""
+  if s = "" then s
+  else if is_space (unsafe_get s 0) || is_space (unsafe_get s (length s - 1))
+    then bts (B.trim (bos s))
+  else s
 
 let escaped s =
-  let n = ref 0 in
-    for i = 0 to length s - 1 do
-      n := !n +
-        (match unsafe_get s i with
-         | '"' | '\\' | '\n' | '\t' | '\r' | '\b' -> 2
-         | c -> if is_printable c then 1 else 4)
-    done;
-    if !n = length s then s else begin
-      let s' = create !n in
-        n := 0;
-        for i = 0 to length s - 1 do
-          begin
-            match unsafe_get s i with
-            | ('"' | '\\') as c ->
-                unsafe_set s' !n '\\'; incr n; unsafe_set s' !n c
-            | '\n' ->
-                unsafe_set s' !n '\\'; incr n; unsafe_set s' !n 'n'
-            | '\t' ->
-                unsafe_set s' !n '\\'; incr n; unsafe_set s' !n 't'
-            | '\r' ->
-                unsafe_set s' !n '\\'; incr n; unsafe_set s' !n 'r'
-            | '\b' ->
-                unsafe_set s' !n '\\'; incr n; unsafe_set s' !n 'b'
-            | c ->
-                if is_printable c then
-                  unsafe_set s' !n c
-                else begin
-                  let a = char_code c in
-                  unsafe_set s' !n '\\';
-                  incr n;
-                  unsafe_set s' !n (char_chr (48 + a / 100));
-                  incr n;
-                  unsafe_set s' !n (char_chr (48 + (a / 10) mod 10));
-                  incr n;
-                  unsafe_set s' !n (char_chr (48 + a mod 10))
-                end
-          end;
-          incr n
-        done;
-        s'
-      end
-
-let map f s =
-  let l = length s in
-  if l = 0 then s else begin
-    let r = create l in
-    for i = 0 to l - 1 do unsafe_set r i (f(unsafe_get s i)) done;
-    r
-  end
-
-let uppercase s = map Char.uppercase s
-let lowercase s = map Char.lowercase s
-
-let apply1 f s =
-  if length s = 0 then s else begin
-    let r = copy s in
-    unsafe_set r 0 (f(unsafe_get s 0));
-    r
-  end
-
-let capitalize s = apply1 Char.uppercase s
-let uncapitalize s = apply1 Char.lowercase s
-
-let rec index_rec s lim i c =
-  if i >= lim then raise Not_found else
-  if unsafe_get s i = c then i else index_rec s lim (i + 1) c;;
-
-let index s c = index_rec s (length s) 0 c;;
-
-let index_from s i c =
-  let l = length s in
-  if i < 0 || i > l then invalid_arg "String.index_from" else
-  index_rec s l i c;;
-
-let rec rindex_rec s i c =
-  if i < 0 then raise Not_found else
-  if unsafe_get s i = c then i else rindex_rec s (i - 1) c;;
-
-let rindex s c = rindex_rec s (length s - 1) c;;
+  let rec needs_escape i =
+    if i >= length s then false else
+      match unsafe_get s i with
+      | '"' | '\\' | '\n' | '\t' | '\r' | '\b' -> true
+      | c when is_printable c -> needs_escape (i+1)
+      | _ -> true
+  in
+  if needs_escape 0 then
+    bts (B.escaped (bos s))
+  else
+    s
 
+let index s c =
+  B.index (bos s) c
+let rindex s c =
+  B.rindex (bos s) c
+let index_from s i c=
+  B.index_from (bos s) i c
 let rindex_from s i c =
-  if i < -1 || i >= length s then invalid_arg "String.rindex_from" else
-  rindex_rec s i c;;
-
+  B.rindex_from (bos s) i c
+let contains s c =
+  B.contains (bos s) c
 let contains_from s i c =
-  let l = length s in
-  if i < 0 || i > l then invalid_arg "String.contains_from" else
-  try ignore (index_rec s l i c); true with Not_found -> false;;
-
-let contains s c = contains_from s 0 c;;
-
+  B.contains_from (bos s) i c
 let rcontains_from s i c =
-  if i < 0 || i >= length s then invalid_arg "String.rcontains_from" else
-  try ignore (rindex_rec s i c); true with Not_found -> false;;
+  B.rcontains_from (bos s) i c
+let uppercase s =
+  B.uppercase (bos s) |> bts
+let lowercase s =
+  B.lowercase (bos s) |> bts
+let capitalize s =
+  B.capitalize (bos s) |> bts
+let uncapitalize s =
+  B.uncapitalize (bos s) |> bts
 
 type t = string
 
diff --git a/stdlib/string.mli b/stdlib/string.mli
index 14f2c82dbb..da6d8351af 100644
--- a/stdlib/string.mli
+++ b/stdlib/string.mli
@@ -13,41 +13,36 @@
 
 (** String operations.
 
-  Given a string [s] of length [l], we call character number in [s]
-  the index of a character in [s].  Indexes start at [0], and we will
-  call a character number valid in [s] if it falls within the range
-  [[0...l-1]]. A position is the point between two characters or at
-  the beginning or end of the string.  We call a position valid
-  in [s] if it falls within the range [[0...l]]. Note that character
-  number [n] is between positions [n] and [n+1].
+  A string is an immutable data structure that contains a
+  fixed-length sequence of (single-byte) characters. Each character
+  can be accessed in constant time through its index.
+
+  Given a string [s] of length [l], we can access each of the [l]
+  characters of [s] via its index in the sequence. Indexes start at
+  [0], and we will call an index valid in [s] if it falls within the
+  range [[0...l-1]] (inclusive). A position is the point between two
+  characters or at the beginning or end of the string.  We call a
+  position valid in [s] if it falls within the range [[0...l]]
+  (inclusive). Note that the character at index [n] is between
+  positions [n] and [n+1].
 
   Two parameters [start] and [len] are said to designate a valid
   substring of [s] if [len >= 0] and [start] and [start+len] are
   valid positions in [s].
 
-  OCaml strings can be modified in place, for instance via the
-  {!String.set} and {!String.blit} functions described below.  This
-  possibility should be used rarely and with much care, however, since
-  both the OCaml compiler and most OCaml libraries share strings as if
-  they were immutable, rather than copying them.  In particular,
-  string literals are shared: a single copy of the string is created
-  at program loading time and returned by all evaluations of the
-  string literal.  Consider for example:
-
-  {[
-      # let f () = "foo";;
-      val f : unit -> string = <fun>
-      # (f ()).[0] <- 'b';;
-      - : unit = ()
-      # f ();;
-      - : string = "boo"
-  ]}
-
-  Likewise, many functions from the standard library can return string
-  literals or one of their string arguments.  Therefore, the returned strings
-  must not be modified directly.  If mutation is absolutely necessary,
-  it should be performed on a fresh copy of the string, as produced by
-  {!String.copy}.
+  OCaml strings used to be modifiable in place, for instance via the
+  {!String.set} and {!String.blit} functions described below. This
+  usage is deprecated and only possible when the compiler is put in
+  "unsafe-string" mode by giving the [-unsafe-string] command-line
+  option (which is currently the default for reasons of backward
+  compatibility). This is done by making the types [string] and
+  [bytes] (see module {!Bytes}) interchangeable so that functions
+  expecting byte sequences can also accept strings as arguments and
+  modify them.
+
+  All new code should avoid this feature and be compiled with the
+  [-safe-string] command-line option to enforce the separation between
+  the types [string] and [bytes].
 
  *)
 
@@ -55,30 +50,45 @@ external length : string -> int = "%string_length"
 (** Return the length (number of characters) of the given string. *)
 
 external get : string -> int -> char = "%string_safe_get"
-(** [String.get s n] returns character number [n] in string [s].
+(** [String.get s n] returns the character at index [n] in string [s].
    You can also write [s.[n]] instead of [String.get s n].
 
-   Raise [Invalid_argument] if [n] not a valid character number in [s]. *)
+   Raise [Invalid_argument] if [n] not a valid index in [s]. *)
 
 
-external set : string -> int -> char -> unit = "%string_safe_set"
-(** [String.set s n c] modifies string [s] in place,
-   replacing the character number [n] by [c].
+external set : bytes -> int -> char -> unit = "%string_safe_set"
+  [@@ocaml.deprecated]
+(** [String.set s n c] modifies byte sequence [s] in place,
+   replacing the byte at index [n] with [c].
    You can also write [s.[n] <- c] instead of [String.set s n c].
 
-   Raise [Invalid_argument] if [n] is not a valid character number in [s]. *)
+   Raise [Invalid_argument] if [n] is not a valid index in [s].
 
-external create : int -> string = "caml_create_string"
-(** [String.create n] returns a fresh string of length [n].
-   The string initially contains arbitrary characters.
+   @deprecated This is a deprecated alias of {!Bytes.set}.[ ] *)
 
-   Raise [Invalid_argument] if [n < 0] or [n > ]{!Sys.max_string_length}. *)
+external create : int -> bytes = "caml_create_string" [@@ocaml.deprecated]
+(** [String.create n] returns a fresh byte sequence of length [n].
+   The sequence is uninitialized and contains arbitrary bytes.
+
+   Raise [Invalid_argument] if [n < 0] or [n > ]{!Sys.max_string_length}.
+
+   @deprecated This is a deprecated alias of {!Bytes.create}.[ ] *)
 
 val make : int -> char -> string
 (** [String.make n c] returns a fresh string of length [n],
    filled with the character [c].
 
-   Raise [Invalid_argument] if [n < 0] or [n > ]{!Sys.max_string_length}.*)
+   Raise [Invalid_argument] if [n < 0] or [n > ]{!Sys.max_string_length}. *)
+
+val init : int -> (int -> char) -> string
+(** [String.init n f] returns a string of length [n], with character
+    [i] initialized to the result of [f i] (called in increasing
+    index order).
+
+    Raise [Invalid_argument] if [n < 0] or [n > ]{!Sys.max_string_length}.
+
+    @since 4.02.0
+*)
 
 val copy : string -> string
 (** Return a copy of the given string. *)
@@ -91,23 +101,23 @@ val sub : string -> int -> int -> string
    Raise [Invalid_argument] if [start] and [len] do not
    designate a valid substring of [s]. *)
 
-val fill : string -> int -> int -> char -> unit
-(** [String.fill s start len c] modifies string [s] in place,
-   replacing [len] characters by [c], starting at [start].
+val fill : bytes -> int -> int -> char -> unit [@@ocaml.deprecated]
+(** [String.fill s start len c] modifies byte sequence [s] in place,
+   replacing [len] bytes with [c], starting at [start].
 
    Raise [Invalid_argument] if [start] and [len] do not
-   designate a valid substring of [s]. *)
+   designate a valid range of [s].
 
-val blit : string -> int -> string -> int -> int -> unit
+   @deprecated This is a deprecated alias of {!Bytes.fill}.[ ] *)
+
+val blit : string -> int -> bytes -> int -> int -> unit
 (** [String.blit src srcoff dst dstoff len] copies [len] characters
-   from string [src], starting at character number [srcoff], to
-   string [dst], starting at character number [dstoff]. It works
-   correctly even if [src] and [dst] are the same string,
-   and the source and destination intervals overlap.
+   (bytes) from the string [src], starting at index [srcoff], to byte
+   sequence [dst], starting at index [dstoff].
 
    Raise [Invalid_argument] if [srcoff] and [len] do not
    designate a valid substring of [src], or if [dstoff] and [len]
-   do not designate a valid substring of [dst]. *)
+   do not designate a valid range of [dst]. *)
 
 val concat : string -> string list -> string
 (** [String.concat sep sl] concatenates the list of strings [sl],
@@ -122,19 +132,24 @@ val iteri : (int -> char -> unit) -> string -> unit
 (** Same as {!String.iter}, but the
    function is applied to the index of the element as first argument
    (counting from 0), and the character itself as second argument.
-   @since 4.00.0
-*)
+   @since 4.00.0 *)
 
 val map : (char -> char) -> string -> string
-(** [String.map f s] applies function [f] in turn to all
-   the characters of [s] and stores the results in a new string that
-   is returned.
-   @since 4.00.0 *)
+(** [String.map f s] applies function [f] in turn to all the
+    characters of [s] (in increasing index order) and stores the
+    results in a new string that is returned.
+    @since 4.00.0 *)
+
+val mapi : (int -> char -> char) -> string -> string
+(** [String.mapi f s] calls [f] with each character of [s] and its
+    index (in increasing index order) and stores the results in a new
+    string that is returned.
+    @since 4.02.0 *)
 
 val trim : string -> string
 (** Return a copy of the argument, without leading and trailing
    whitespace.  The characters regarded as whitespace are: [' '],
-   ['\012'], ['\n'], ['\r'], and ['\t'].  If there is no leading nor
+   ['\012'], ['\n'], ['\r'], and ['\t'].  If there is neither leading nor
    trailing whitespace character in the argument, return the original
    string itself, not a copy.
    @since 4.00.0 *)
@@ -147,19 +162,19 @@ val escaped : string -> string
    not a copy. Its inverse function is Scanf.unescaped. *)
 
 val index : string -> char -> int
-(** [String.index s c] returns the character number of the first
+(** [String.index s c] returns the index of the first
    occurrence of character [c] in string [s].
 
    Raise [Not_found] if [c] does not occur in [s]. *)
 
 val rindex : string -> char -> int
-(** [String.rindex s c] returns the character number of the last
+(** [String.rindex s c] returns the index of the last
    occurrence of character [c] in string [s].
 
    Raise [Not_found] if [c] does not occur in [s]. *)
 
 val index_from : string -> int -> char -> int
-(** [String.index_from s i c] returns the character number of the
+(** [String.index_from s i c] returns the index of the
    first occurrence of character [c] in string [s] after position [i].
    [String.index s c] is equivalent to [String.index_from s 0 c].
 
@@ -167,7 +182,7 @@ val index_from : string -> int -> char -> int
    Raise [Not_found] if [c] does not occur in [s] after position [i]. *)
 
 val rindex_from : string -> int -> char -> int
-(** [String.rindex_from s i c] returns the character number of the
+(** [String.rindex_from s i c] returns the index of the
    last occurrence of character [c] in string [s] before position [i+1].
    [String.rindex s c] is equivalent to
    [String.rindex_from s (String.length s - 1) c].
@@ -224,8 +239,11 @@ val compare: t -> t -> int
 (* The following is for system use only. Do not call directly. *)
 
 external unsafe_get : string -> int -> char = "%string_unsafe_get"
-external unsafe_set : string -> int -> char -> unit = "%string_unsafe_set"
+external unsafe_set : bytes -> int -> char -> unit = "%string_unsafe_set"
+  [@@ocaml.deprecated]
 external unsafe_blit :
-  string -> int -> string -> int -> int -> unit = "caml_blit_string" "noalloc"
+  string -> int -> bytes -> int -> int -> unit
+  = "caml_blit_string" "noalloc"
 external unsafe_fill :
-  string -> int -> int -> char -> unit = "caml_fill_string" "noalloc"
+  bytes -> int -> int -> char -> unit = "caml_fill_string" "noalloc"
+  [@@ocaml.deprecated]
diff --git a/stdlib/stringLabels.mli b/stdlib/stringLabels.mli
index 8e2e6d3798..dcef6db036 100644
--- a/stdlib/stringLabels.mli
+++ b/stdlib/stringLabels.mli
@@ -17,61 +17,71 @@ external length : string -> int = "%string_length"
 (** Return the length (number of characters) of the given string. *)
 
 external get : string -> int -> char = "%string_safe_get"
-(** [String.get s n] returns character number [n] in string [s].
-   The first character is character number 0.
-   The last character is character number [String.length s - 1].
+(** [String.get s n] returns the character at index [n] in string [s].
    You can also write [s.[n]] instead of [String.get s n].
 
-   Raise [Invalid_argument "index out of bounds"]
-   if [n] is outside the range 0 to [(String.length s - 1)]. *)
+   Raise [Invalid_argument] if [n] not a valid index in [s]. *)
 
-
-external set : string -> int -> char -> unit = "%string_safe_set"
-(** [String.set s n c] modifies string [s] in place,
-   replacing the character number [n] by [c].
+external set : bytes -> int -> char -> unit = "%string_safe_set"
+  [@@ocaml.deprecated]
+(** [String.set s n c] modifies byte sequence [s] in place,
+   replacing the byte at index [n] with [c].
    You can also write [s.[n] <- c] instead of [String.set s n c].
-   Raise [Invalid_argument "index out of bounds"]
-   if [n] is outside the range 0 to [(String.length s - 1)]. *)
 
-external create : int -> string = "caml_create_string"
-(** [String.create n] returns a fresh string of length [n].
-   The string initially contains arbitrary characters.
-   Raise [Invalid_argument] if [n < 0] or [n > Sys.max_string_length].
-*)
+   Raise [Invalid_argument] if [n] is not a valid index in [s].
+
+   @deprecated This is a deprecated alias of {!Bytes.set}. *)
+
+external create : int -> bytes = "caml_create_string" [@@ocaml.deprecated]
+(** [String.create n] returns a fresh byte sequence of length [n].
+   The sequence is uninitialized and contains arbitrary bytes.
+
+   Raise [Invalid_argument] if [n < 0] or [n > ]{!Sys.max_string_length}.
+
+   @deprecated This is a deprecated alias of {!Bytes.create}. *)
 
 val make : int -> char -> string
 (** [String.make n c] returns a fresh string of length [n],
    filled with the character [c].
-   Raise [Invalid_argument] if [n < 0] or [n > ]{!Sys.max_string_length}.*)
+
+   Raise [Invalid_argument] if [n < 0] or [n > ]{!Sys.max_string_length}. *)
+
+val init : int -> f:(int -> char) -> string
+(** [init n f] returns a string of length [n],
+    with character [i] initialized to the result of [f i].
+
+   Raise [Invalid_argument] if [n < 0] or [n > ]{!Sys.max_string_length}. *)
 
 val copy : string -> string
 (** Return a copy of the given string. *)
 
 val sub : string -> pos:int -> len:int -> string
 (** [String.sub s start len] returns a fresh string of length [len],
-   containing the characters number [start] to [start + len - 1]
-   of string [s].
-   Raise [Invalid_argument] if [start] and [len] do not
-   designate a valid substring of [s]; that is, if [start < 0],
-   or [len < 0], or [start + len > ]{!StringLabels.length}[ s]. *)
+   containing the substring of [s] that starts at position [start] and
+   has length [len].
 
-val fill : string -> pos:int -> len:int -> char -> unit
-(** [String.fill s start len c] modifies string [s] in place,
-   replacing the characters number [start] to [start + len - 1]
-   by [c].
    Raise [Invalid_argument] if [start] and [len] do not
    designate a valid substring of [s]. *)
 
+val fill : bytes -> pos:int -> len:int -> char -> unit [@@ocaml.deprecated]
+(** [String.fill s start len c] modifies byte sequence [s] in place,
+   replacing [len] bytes by [c], starting at [start].
+
+   Raise [Invalid_argument] if [start] and [len] do not
+   designate a valid substring of [s].
+
+   @deprecated This is a deprecated alias of {!Bytes.fill}. *)
+
 val blit :
-  src:string -> src_pos:int -> dst:string -> dst_pos:int -> len:int -> unit
-(** [String.blit src srcoff dst dstoff len] copies [len] characters
-   from string [src], starting at character number [srcoff], to
-   string [dst], starting at character number [dstoff]. It works
-   correctly even if [src] and [dst] are the same string,
-   and the source and destination chunks overlap.
+  src:string -> src_pos:int -> dst:bytes -> dst_pos:int -> len:int
+  -> unit
+(** [String.blit src srcoff dst dstoff len] copies [len] bytes
+   from the string [src], starting at index [srcoff],
+   to byte sequence [dst], starting at character number [dstoff].
+
    Raise [Invalid_argument] if [srcoff] and [len] do not
-   designate a valid substring of [src], or if [dstoff] and [len]
-   do not designate a valid substring of [dst]. *)
+   designate a valid range of [src], or if [dstoff] and [len]
+   do not designate a valid range of [dst]. *)
 
 val concat : sep:string -> string list -> string
 (** [String.concat sep sl] concatenates the list of strings [sl],
@@ -86,8 +96,7 @@ val iteri : f:(int -> char -> unit) -> string -> unit
 (** Same as {!String.iter}, but the
    function is applied to the index of the element as first argument
    (counting from 0), and the character itself as second argument.
-   @since 4.00.0
-*)
+   @since 4.00.0 *)
 
 val map : f:(char -> char) -> string -> string
 (** [String.map f s] applies function [f] in turn to all
@@ -96,10 +105,11 @@ val map : f:(char -> char) -> string -> string
    @since 4.00.0 *)
 
 val trim : string -> string
-(** Return a copy of the argument, without leading and trailing whitespace.
-   The characters regarded as whitespace are: [' '], ['\012'], ['\n'],
-   ['\r'], and ['\t'].  If there is no whitespace character in the argument,
-   return the original string itself, not a copy.
+(** Return a copy of the argument, without leading and trailing
+   whitespace.  The characters regarded as whitespace are: [' '],
+   ['\012'], ['\n'], ['\r'], and ['\t'].  If there is no leading nor
+   trailing whitespace character in the argument, return the original
+   string itself, not a copy.
    @since 4.00.0 *)
 
 val escaped : string -> string
@@ -107,28 +117,36 @@ val escaped : string -> string
    represented by escape sequences, following the lexical
    conventions of OCaml.  If there is no special
    character in the argument, return the original string itself,
-   not a copy. *)
+   not a copy. Its inverse function is Scanf.unescaped. *)
 
 val index : string -> char -> int
-(** [String.index s c] returns the position of the leftmost
+(** [String.index s c] returns the index of the first
    occurrence of character [c] in string [s].
+
    Raise [Not_found] if [c] does not occur in [s]. *)
 
 val rindex : string -> char -> int
-(** [String.rindex s c] returns the position of the rightmost
+(** [String.rindex s c] returns the index of the last
    occurrence of character [c] in string [s].
+
    Raise [Not_found] if [c] does not occur in [s]. *)
 
 val index_from : string -> int -> char -> int
-(** Same as {!StringLabels.index}, but start
-   searching at the character position given as second argument.
-   [String.index s c] is equivalent to [String.index_from s 0 c].*)
+(** [String.index_from s i c] returns the index of the
+   first occurrence of character [c] in string [s] after position [i].
+   [String.index s c] is equivalent to [String.index_from s 0 c].
+
+   Raise [Invalid_argument] if [i] is not a valid position in [s].
+   Raise [Not_found] if [c] does not occur in [s] after position [i]. *)
 
 val rindex_from : string -> int -> char -> int
-(** Same as {!StringLabels.rindex}, but start
-   searching at the character position given as second argument.
+(** [String.rindex_from s i c] returns the index of the
+   last occurrence of character [c] in string [s] before position [i+1].
    [String.rindex s c] is equivalent to
-   [String.rindex_from s (String.length s - 1) c]. *)
+   [String.rindex_from s (String.length s - 1) c].
+
+   Raise [Invalid_argument] if [i+1] is not a valid position in [s].
+   Raise [Not_found] if [c] does not occur in [s] before position [i+1]. *)
 
 val contains : string -> char -> bool
 (** [String.contains s c] tests if character [c]
@@ -136,15 +154,18 @@ val contains : string -> char -> bool
 
 val contains_from : string -> int -> char -> bool
 (** [String.contains_from s start c] tests if character [c]
-   appears in the substring of [s] starting from [start] to the end
-   of [s].
-   Raise [Invalid_argument] if [start] is not a valid index of [s]. *)
+   appears in [s] after position [start].
+   [String.contains s c] is equivalent to
+   [String.contains_from s 0 c].
+
+   Raise [Invalid_argument] if [start] is not a valid position in [s]. *)
 
 val rcontains_from : string -> int -> char -> bool
 (** [String.rcontains_from s stop c] tests if character [c]
-   appears in the substring of [s] starting from the beginning
-   of [s] to index [stop].
-   Raise [Invalid_argument] if [stop] is not a valid index of [s]. *)
+   appears in [s] before position [stop+1].
+
+   Raise [Invalid_argument] if [stop < 0] or [stop+1] is not a valid
+   position in [s]. *)
 
 val uppercase : string -> string
 (** Return a copy of the argument, with all lowercase letters
@@ -176,9 +197,11 @@ val compare: t -> t -> int
 (* The following is for system use only. Do not call directly. *)
 
 external unsafe_get : string -> int -> char = "%string_unsafe_get"
-external unsafe_set : string -> int -> char -> unit = "%string_unsafe_set"
+external unsafe_set : bytes -> int -> char -> unit = "%string_unsafe_set"
+  [@@ocaml.deprecated]
 external unsafe_blit :
-  src:string -> src_pos:int -> dst:string -> dst_pos:int -> len:int ->
+  src:string -> src_pos:int -> dst:bytes -> dst_pos:int -> len:int ->
     unit = "caml_blit_string" "noalloc"
 external unsafe_fill :
-  string -> pos:int -> len:int -> char -> unit = "caml_fill_string" "noalloc"
+  bytes -> pos:int -> len:int -> char -> unit = "caml_fill_string" "noalloc"
+  [@@ocaml.deprecated]
diff --git a/stdlib/sys.mli b/stdlib/sys.mli
index 944b1090f6..0f3b131ada 100644
--- a/stdlib/sys.mli
+++ b/stdlib/sys.mli
@@ -99,7 +99,7 @@ val big_endian : bool
     @since 4.00.0 *)
 
 val max_string_length : int
-(** Maximum length of a string. *)
+(** Maximum length of strings and byte sequences. *)
 
 val max_array_length : int
 (** Maximum length of a normal array.  The maximum length of a float
diff --git a/testsuite/external/.ignore b/testsuite/external/.ignore
index 8b57bbb1eb..39e14de915 100644
--- a/testsuite/external/.ignore
+++ b/testsuite/external/.ignore
@@ -26,7 +26,7 @@ camlpdf-0.5
 camlp4
 camlp4-trunk
 camlp5
-camlp5-6.10
+camlp5-git
 camlzip
 camlzip-1.04
 camomile
diff --git a/testsuite/external/Makefile b/testsuite/external/Makefile
index 33acd2ae64..566aaf3921 100644
--- a/testsuite/external/Makefile
+++ b/testsuite/external/Makefile
@@ -44,10 +44,10 @@ all-cygwin: findlib ounit res pcre react ocamltext ocamlssl camlzip cryptokit \
 
 all-macos: findlib res pcre react ocamltext \
            ocamlssl camlzip cryptokit sqlite menhir hevea \
-           xmllight xmlm omake \
+           xmllight xmlm omake zen \
            altergo boomerang vsyml extlib \
            ocamlify calendar \
-           dbm framac
+           dbm geneweb framac coq compcert
 
 platform:
 	case `uname -s` in \
@@ -1573,56 +1573,53 @@ distclean::
 	rm -f ${CSV}.tar.gz
 all: csv
 
-# disabled: need to be updated for new AST stuff
-# # http://pauillac.inria.fr/~ddr/camlp5/
-# CAMLP5=camlp5-6.10
-# ${CAMLP5}.tgz:
-# 	${WGET} http://pauillac.inria.fr/~ddr/camlp5/distrib/src/$@
-# camlp5: ${CAMLP5}.tgz
-# 	printf "%s " "$@" >/dev/tty
-# 	test -d ${PREFIX}
-# 	rm -rf ${CAMLP5}
-# 	tar zxf ${CAMLP5}.tgz
-# 	./Patcher.sh ${CAMLP5}
-# 	( cd ${CAMLP5} && \
-# 	  export PATH=${PREFIX}/bin:$$PATH && \
-# 	  ./configure --transitional && \
-# 	  ${MAKE} world.opt && \
-# 	  ${MAKE} install )
-# 	echo ${VERSION} >$@
-# clean::
-# 	rm -rf ${CAMLP5} camlp5
-# distclean::
-# 	rm -f ${CAMLP5}.tgz
-# all: camlp5
-
-# disabled: depends on camlp5
-# # http://opensource.geneanet.org/projects/geneweb
-# GENEWEB=gw-6.05-src
-# ${GENEWEB}.tgz:
-# 	${WGET} http://opensource.geneanet.org/attachments/download/190/$@
-# geneweb: ${GENEWEB}.tgz camlp5
-# 	printf "%s " "$@" >/dev/tty
-# 	test -d ${PREFIX}
-# 	rm -rf ${GENEWEB}
-# 	tar zxf ${GENEWEB}.tgz
-# 	./Patcher.sh ${GENEWEB}
-# 	( cd ${GENEWEB} && \
-# 	  export PATH=${PREFIX}/bin:$$PATH && \
-# 	  sh ./configure && \
-# 	  ${MAKE} )
-# 	echo ${VERSION} >$@
-# clean::
-# 	rm -rf ${GENEWEB} geneweb
-# distclean::
-# 	rm -f ${GENEWEB}.tgz
-# all: geneweb
+# http://pauillac.inria.fr/~ddr/camlp5/
+CAMLP5=camlp5-git
+camlp5:
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${CAMLP5}
+	git clone git://scm.gforge.inria.fr/camlp5/camlp5.git ${CAMLP5}
+	./Patcher.sh ${CAMLP5}
+	( cd ${CAMLP5} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  ./configure --transitional && \
+	  ${MAKE} world.opt && \
+	  ${MAKE} install )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${CAMLP5} camlp5
+distclean::
+	rm -f ${CAMLP5}-git
+all: camlp5
+
+disabled: depends on camlp5
+# http://opensource.geneanet.org/projects/geneweb
+GENEWEB=gw-6.05-src
+${GENEWEB}.tgz:
+	${WGET} http://opensource.geneanet.org/attachments/download/190/$@
+geneweb: ${GENEWEB}.tgz camlp5
+	printf "%s " "$@" >/dev/tty
+	test -d ${PREFIX}
+	rm -rf ${GENEWEB}
+	tar zxf ${GENEWEB}.tgz
+	./Patcher.sh ${GENEWEB}
+	( cd ${GENEWEB} && \
+	  export PATH=${PREFIX}/bin:$$PATH && \
+	  sh ./configure && \
+	  ${MAKE} )
+	echo ${VERSION} >$@
+clean::
+	rm -rf ${GENEWEB} geneweb
+distclean::
+	rm -f ${GENEWEB}.tgz
+all: geneweb
 
 # http://coq.inria.fr/download
 COQ=coq-8.4pl2
 ${COQ}.tar.gz:
 	${WGET} http://coq.inria.fr/distrib/V8.4pl2/files/$@
-xxcoq: ${COQ}.tar.gz camlp5
+coq: ${COQ}.tar.gz camlp5
 	printf "%s " "$@" >/dev/tty
 	test -d ${PREFIX}
 	rm -rf ${COQ}
diff --git a/testsuite/external/camlp5-git.patch b/testsuite/external/camlp5-git.patch
new file mode 100644
index 0000000000..8ea012cc5c
--- /dev/null
+++ b/testsuite/external/camlp5-git.patch
@@ -0,0 +1,12 @@
+diff --git a/Makefile b/Makefile
+index 13622f7..b33a042 100644
+--- camlp5-git/Makefile.orig
++++ camlp5-git/Makefile
+@@ -54,6 +54,7 @@ depend:
+ 	cd ocaml_stuff; $(MAKE) depend; cd ..
+ 	for i in $(DIRS) compile; do (cd $$i; $(MAKE) depend; cd ..); done
+ 
++.PHONY: install
+ install:
+ 	rm -rf "$(DESTDIR)$(LIBDIR)/$(CAMLP5N)"
+ 	for i in $(DIRS) compile; do \
diff --git a/testsuite/makefiles/Makefile.common b/testsuite/makefiles/Makefile.common
index ae6aceaa2e..5fdf5a1846 100644
--- a/testsuite/makefiles/Makefile.common
+++ b/testsuite/makefiles/Makefile.common
@@ -110,7 +110,7 @@ defaultclean:
 .cmxa.so:
 	@$(OCAMLOPT) -o $@ -shared -linkall $(ADD_COMPFLAGS) $<
 
-.mly.ml:
+%.ml %.mli: %.mly
 	@$(OCAMLYACC) -q $< 2> /dev/null
 
 .mll.ml:
diff --git a/testsuite/tests/asmcomp/lexcmm.mll b/testsuite/tests/asmcomp/lexcmm.mll
index e9efdb60ff..4c262b1122 100644
--- a/testsuite/tests/asmcomp/lexcmm.mll
+++ b/testsuite/tests/asmcomp/lexcmm.mll
@@ -81,7 +81,7 @@ let keyword_table =
 
 (* To buffer string literals *)
 
-let initial_string_buffer = String.create 256
+let initial_string_buffer = Bytes.create 256
 let string_buff = ref initial_string_buffer
 let string_index = ref 0
 
@@ -90,16 +90,16 @@ let reset_string_buffer () =
   string_index := 0
 
 let store_string_char c =
-  if !string_index >= String.length (!string_buff) then begin
-    let new_buff = String.create (String.length (!string_buff) * 2) in
-      String.blit (!string_buff) 0 new_buff 0 (String.length (!string_buff));
-      string_buff := new_buff
+  if !string_index >= Bytes.length (!string_buff) then begin
+    let new_buff = Bytes.create (Bytes.length (!string_buff) * 2) in
+    Bytes.blit (!string_buff) 0 new_buff 0 (Bytes.length (!string_buff));
+    string_buff := new_buff
   end;
-  String.unsafe_set (!string_buff) (!string_index) c;
+  Bytes.unsafe_set (!string_buff) (!string_index) c;
   incr string_index
 
 let get_stored_string () =
-  let s = String.sub (!string_buff) 0 (!string_index) in
+  let s = Bytes.sub_string (!string_buff) 0 (!string_index) in
   string_buff := initial_string_buffer;
   s
 
diff --git a/testsuite/tests/asmcomp/parsecmm.mly b/testsuite/tests/asmcomp/parsecmm.mly
index ad697b6f4b..c81ca619b6 100644
--- a/testsuite/tests/asmcomp/parsecmm.mly
+++ b/testsuite/tests/asmcomp/parsecmm.mly
@@ -172,7 +172,7 @@ componentlist:
 ;
 expr:
     INTCONST    { Cconst_int $1 }
-  | FLOATCONST  { Cconst_float $1 }
+  | FLOATCONST  { Cconst_float (float_of_string $1) }
   | STRING      { Cconst_symbol $1 }
   | POINTER     { Cconst_pointer $1 }
   | IDENT       { Cvar(find_ident $1) }
@@ -316,7 +316,7 @@ dataitem:
   | BYTE INTCONST               { Cint8 $2 }
   | HALF INTCONST               { Cint16 $2 }
   | INT INTCONST                { Cint(Nativeint.of_int $2) }
-  | FLOAT FLOATCONST            { Cdouble $2 }
+  | FLOAT FLOATCONST            { Cdouble (float_of_string $2) }
   | ADDR STRING                 { Csymbol_address $2 }
   | ADDR INTCONST               { Clabel_address $2 }
   | KSTRING STRING              { Cstring $2 }
diff --git a/testsuite/tests/asmcomp/sparc.S b/testsuite/tests/asmcomp/sparc.S
index 53c5fc9029..ea029573a0 100644
--- a/testsuite/tests/asmcomp/sparc.S
+++ b/testsuite/tests/asmcomp/sparc.S
@@ -11,11 +11,11 @@
 /***********************************************************************/
 
 #if defined(SYS_solaris) || defined(SYS_elf)
-#define Call_gen_code _call_gen_code
-#define Caml_c_call _caml_c_call
-#else
 #define Call_gen_code call_gen_code
 #define Caml_c_call caml_c_call
+#else
+#define Call_gen_code _call_gen_code
+#define Caml_c_call _caml_c_call
 #endif
 
         .global Call_gen_code
diff --git a/testsuite/tests/backtrace/Makefile b/testsuite/tests/backtrace/Makefile
index 32533fd606..1ca390f942 100644
--- a/testsuite/tests/backtrace/Makefile
+++ b/testsuite/tests/backtrace/Makefile
@@ -14,7 +14,8 @@ BASEDIR=../..
 EXECNAME=program$(EXE)
 
 ABCDFILES=backtrace.ml
-OTHERFILES=backtrace2.ml raw_backtrace.ml
+OTHERFILES=backtrace2.ml raw_backtrace.ml \
+           backtrace_deprecated.ml backtrace_slots.ml
 
 default:
 	$(MAKE) byte
diff --git a/testsuite/tests/backtrace/backtrace_deprecated.ml b/testsuite/tests/backtrace/backtrace_deprecated.ml
new file mode 100644
index 0000000000..7ec5152d0c
--- /dev/null
+++ b/testsuite/tests/backtrace/backtrace_deprecated.ml
@@ -0,0 +1,50 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Gallium, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 2008 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.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* A test for stack backtraces *)
+
+external get_backtrace : unit -> Printexc.backtrace_slot array option
+  = "caml_get_exception_backtrace"
+
+exception Error of string
+
+let rec f msg n =
+  if n = 0 then raise(Error msg) else 1 + f msg (n-1)
+
+let g msg =
+  try
+    f msg 5
+  with Error "a" -> print_string "a"; print_newline(); 0
+     | Error "b" as exn -> print_string "b"; print_newline(); raise exn
+     | Error "c" -> raise (Error "c")
+
+let run args =
+  try
+    ignore (g args.(0)); print_string "No exception\n"
+  with exn ->
+    Printf.printf "Uncaught exception %s\n" (Printexc.to_string exn);
+    get_backtrace () |> function
+    | None -> ()
+    | Some trace ->
+      Array.iteri
+        (fun i slot -> match Printexc.Slot.format i slot with
+          | None -> ()
+          | Some line -> print_endline line)
+        trace
+
+let _ =
+  Printexc.record_backtrace true;
+  run [| "a" |];
+  run [| "b" |];
+  run [| "c" |];
+  run [| "d" |];
+  run [| |]
diff --git a/testsuite/tests/backtrace/backtrace_deprecated.reference b/testsuite/tests/backtrace/backtrace_deprecated.reference
new file mode 100644
index 0000000000..e9fea9ffe5
--- /dev/null
+++ b/testsuite/tests/backtrace/backtrace_deprecated.reference
@@ -0,0 +1,27 @@
+a
+No exception
+b
+Uncaught exception Backtrace_deprecated.Error("b")
+Raised at file "backtrace_deprecated.ml", line 21, characters 21-32
+Called from file "backtrace_deprecated.ml", line 21, characters 42-53
+Called from file "backtrace_deprecated.ml", line 21, characters 42-53
+Called from file "backtrace_deprecated.ml", line 21, characters 42-53
+Called from file "backtrace_deprecated.ml", line 21, characters 42-53
+Called from file "backtrace_deprecated.ml", line 21, characters 42-53
+Called from file "backtrace_deprecated.ml", line 25, characters 4-11
+Re-raised at file "backtrace_deprecated.ml", line 27, characters 68-71
+Called from file "backtrace_deprecated.ml", line 32, characters 11-23
+Uncaught exception Backtrace_deprecated.Error("c")
+Raised at file "backtrace_deprecated.ml", line 28, characters 26-37
+Called from file "backtrace_deprecated.ml", line 32, characters 11-23
+Uncaught exception Backtrace_deprecated.Error("d")
+Raised at file "backtrace_deprecated.ml", line 21, characters 21-32
+Called from file "backtrace_deprecated.ml", line 21, characters 42-53
+Called from file "backtrace_deprecated.ml", line 21, characters 42-53
+Called from file "backtrace_deprecated.ml", line 21, characters 42-53
+Called from file "backtrace_deprecated.ml", line 21, characters 42-53
+Called from file "backtrace_deprecated.ml", line 21, characters 42-53
+Called from file "backtrace_deprecated.ml", line 25, characters 4-11
+Called from file "backtrace_deprecated.ml", line 32, characters 11-23
+Uncaught exception Invalid_argument("index out of bounds")
+Raised by primitive operation at file "backtrace_deprecated.ml", line 32, characters 14-22
diff --git a/testsuite/tests/backtrace/backtrace_slots.ml b/testsuite/tests/backtrace/backtrace_slots.ml
new file mode 100644
index 0000000000..8419c61905
--- /dev/null
+++ b/testsuite/tests/backtrace/backtrace_slots.ml
@@ -0,0 +1,72 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Gallium, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 2008 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.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* A test for stack backtraces *)
+
+let get_backtrace () =
+  let raw_backtrace = Printexc.get_raw_backtrace () in
+  let raw_slots =
+    Array.init (Printexc.raw_backtrace_length raw_backtrace)
+               (Printexc.get_raw_backtrace_slot raw_backtrace) in
+  let convert = Printexc.convert_raw_backtrace_slot in
+  let backtrace = Array.map convert raw_slots in
+  (* we'll play with raw slots a bit to check that hashing and comparison work:
+     - create a hashtable that maps slots to their index in the raw backtrace
+     - create a balanced set of all slots
+  *)
+  let table = Hashtbl.create 100 in
+  Array.iteri (fun i slot -> Hashtbl.add table slot i) raw_slots;
+  let module S = Set.Make(struct
+    type t = Printexc.raw_backtrace_slot
+    let compare = Pervasives.compare
+  end) in
+  let slots = Array.fold_right S.add raw_slots S.empty in
+  Array.iteri (fun i slot ->
+    assert (S.mem slot slots);
+    assert (Hashtbl.mem table slot);
+    let j =
+      (* position in the table of the last slot equal to [slot] *)
+      Hashtbl.find table slot in
+    assert (slot = raw_slots.(j));
+    assert (backtrace.(i) = backtrace.(j));
+  ) raw_slots;
+  backtrace
+
+exception Error of string
+
+let rec f msg n =
+  if n = 0 then raise(Error msg) else 1 + f msg (n-1)
+
+let g msg =
+  try
+    f msg 5
+  with Error "a" -> print_string "a"; print_newline(); 0
+     | Error "b" as exn -> print_string "b"; print_newline(); raise exn
+     | Error "c" -> raise (Error "c")
+
+let run args =
+  try
+    ignore (g args.(0)); print_string "No exception\n"
+  with exn ->
+    Printf.printf "Uncaught exception %s\n" (Printexc.to_string exn);
+    get_backtrace () |> Array.iteri
+        (fun i slot -> match Printexc.Slot.format i slot with
+          | None -> ()
+          | Some line -> print_endline line)
+
+let _ =
+  Printexc.record_backtrace true;
+  run [| "a" |];
+  run [| "b" |];
+  run [| "c" |];
+  run [| "d" |];
+  run [| |]
diff --git a/testsuite/tests/backtrace/backtrace_slots.reference b/testsuite/tests/backtrace/backtrace_slots.reference
new file mode 100644
index 0000000000..2336cd5ac3
--- /dev/null
+++ b/testsuite/tests/backtrace/backtrace_slots.reference
@@ -0,0 +1,27 @@
+a
+No exception
+b
+Uncaught exception Backtrace_slots.Error("b")
+Raised at file "backtrace_slots.ml", line 47, characters 21-32
+Called from file "backtrace_slots.ml", line 47, characters 42-53
+Called from file "backtrace_slots.ml", line 47, characters 42-53
+Called from file "backtrace_slots.ml", line 47, characters 42-53
+Called from file "backtrace_slots.ml", line 47, characters 42-53
+Called from file "backtrace_slots.ml", line 47, characters 42-53
+Called from file "backtrace_slots.ml", line 51, characters 4-11
+Re-raised at file "backtrace_slots.ml", line 53, characters 68-71
+Called from file "backtrace_slots.ml", line 58, characters 11-23
+Uncaught exception Backtrace_slots.Error("c")
+Raised at file "backtrace_slots.ml", line 54, characters 26-37
+Called from file "backtrace_slots.ml", line 58, characters 11-23
+Uncaught exception Backtrace_slots.Error("d")
+Raised at file "backtrace_slots.ml", line 47, characters 21-32
+Called from file "backtrace_slots.ml", line 47, characters 42-53
+Called from file "backtrace_slots.ml", line 47, characters 42-53
+Called from file "backtrace_slots.ml", line 47, characters 42-53
+Called from file "backtrace_slots.ml", line 47, characters 42-53
+Called from file "backtrace_slots.ml", line 47, characters 42-53
+Called from file "backtrace_slots.ml", line 51, characters 4-11
+Called from file "backtrace_slots.ml", line 58, characters 11-23
+Uncaught exception Invalid_argument("index out of bounds")
+Raised by primitive operation at file "backtrace_slots.ml", line 58, characters 14-22
diff --git a/testsuite/tests/basic-io-2/io.ml b/testsuite/tests/basic-io-2/io.ml
index 14e458cdde..8c71206a83 100644
--- a/testsuite/tests/basic-io-2/io.ml
+++ b/testsuite/tests/basic-io-2/io.ml
@@ -25,7 +25,7 @@ let test msg funct f1 f2 =
 let copy_file sz infile ofile =
   let ic = open_in_bin infile in
   let oc = open_out_bin ofile in
-  let buffer = String.create sz in
+  let buffer = Bytes.create sz in
   let rec copy () =
     let n = input ic buffer 0 sz in
     if n = 0 then () else begin
@@ -41,7 +41,7 @@ let copy_file sz infile ofile =
 let copy_random sz infile ofile =
   let ic = open_in_bin infile in
   let oc = open_out_bin ofile in
-  let buffer = String.create sz in
+  let buffer = Bytes.create sz in
   let rec copy () =
     let s = 1 + Random.int sz in
     let n = input ic buffer 0 s in
@@ -72,7 +72,7 @@ let copy_seek chunksize infile ofile =
   let ic = open_in_bin infile in
   let oc = open_out_bin ofile in
   let size = in_channel_length ic in
-  let buffer = String.create chunksize in
+  let buffer = Bytes.create chunksize in
   for i = (size - 1) / chunksize downto 0 do
     seek_in ic (i * chunksize);
     seek_out oc (i * chunksize);
diff --git a/testsuite/tests/basic-more/pr2719.ml b/testsuite/tests/basic-more/pr2719.ml
new file mode 100644
index 0000000000..f0a9d6a4f9
--- /dev/null
+++ b/testsuite/tests/basic-more/pr2719.ml
@@ -0,0 +1,17 @@
+open Printf
+
+let bug () =
+  let mat = [| [|false|] |]
+  and test = ref false in
+    printf "Value of test at the beginning : %b\n" !test; flush stdout;
+    (try let _ = mat.(0).(-1) in
+       (test := true;
+        printf "Am I going through this block of instructions ?\n";
+        flush stdout)
+     with Invalid_argument _ -> printf "Value of test now : %b\n" !test
+    );
+    (try if mat.(0).(-1) then ()
+     with Invalid_argument _ -> ()
+    )
+
+let () = bug ()
diff --git a/testsuite/tests/basic-more/pr2719.reference b/testsuite/tests/basic-more/pr2719.reference
new file mode 100644
index 0000000000..073d0916d9
--- /dev/null
+++ b/testsuite/tests/basic-more/pr2719.reference
@@ -0,0 +1,4 @@
+Value of test at the beginning : false
+Value of test now : false
+
+All tests succeeded.
diff --git a/testsuite/tests/basic-more/tprintf.ml b/testsuite/tests/basic-more/tprintf.ml
index 9ea9366f5b..5777739fe5 100644
--- a/testsuite/tests/basic-more/tprintf.ml
+++ b/testsuite/tests/basic-more/tprintf.ml
@@ -20,7 +20,8 @@ let test0 () =
   sprintf "%.0f" 1.0 = "1" &&
   sprintf "%.0f." 1.7 = "2." &&
   sprintf "%.1f." 1.0 = "1.0." &&
-  sprintf "%0.1f." 12.0 = "12.0." &&
+  (*sprintf "%0.1f." 12.0 = "12.0." &&*)
+    (* >> '0' w/o padding *)
   sprintf "%3.1f." 12.0 = "12.0." &&
   sprintf "%5.1f." 12.0 = " 12.0." &&
   sprintf "%10.1f." 12.0 = "      12.0." &&
@@ -33,7 +34,8 @@ let test0 () =
   sprintf "%010.0f." 12.0 = "0000000012." &&
   sprintf "% 10.0f." 12.0 = "        12." &&
 
-  sprintf "%0.1f." 12.0 = "12.0." &&
+  (*sprintf "%0.1f." 12.0 = "12.0." &&*)
+    (* >> '0' w/o padding *)
   sprintf "%10.1f." 1.001 = "       1.0." &&
   sprintf "%05.1f." 1.001 = "001.0."
 ;;
@@ -59,8 +61,9 @@ test (test2 ());;
 
 (* Testing meta format string printing. *)
 let test3 () =
-sprintf "%{toto %s titi.\n%}" "Bonjour %s." = "%s" &&
-sprintf "%{%d%s%}" "kk%dkk%s\n" = "%i%s";;
+  sprintf "%{toto %S titi.\n%}" "Bonjour %S." = "%s" &&
+  sprintf "%{Bonjour %S.%}" "toto %S titi.\n" = "%s"
+;;
 test (test3 ());;
 
 (* Testing meta format string arguments. *)
diff --git a/testsuite/tests/basic/constprop.ml b/testsuite/tests/basic/constprop.ml
new file mode 100644
index 0000000000..6661291316
--- /dev/null
+++ b/testsuite/tests/basic/constprop.ml
@@ -0,0 +1,72 @@
+(***********************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy, projet Gallium, INRIA Rocquencourt *)
+(* *)
+(* Copyright 2014 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. *)
+(* *)
+(***********************************************************************)
+
+(* Test constant propagation through inlining *)
+
+(* constprop.ml is generated from constprop.mlp using
+      cpp constprop.mlp > constprop.ml
+*)
+let do_test msg res1 res2 =
+  Printf.printf "%s: %s\n" msg (if res1 = res2 then "passed" else "FAILED")
+(* Hide a constant from the optimizer, preventing constant propagation *)
+let hide x = List.nth [x] 0
+let _ =
+  begin
+    let x = true and y = false in
+    let xh = hide x and yh = hide y in
+    do_test "booleans" ((x && y, x || y, not x)) ((xh && yh, xh || yh, not xh))
+  end;
+  begin
+    let x = 89809344 and y = 457455773 and s = 7 in
+    let xh = hide x and yh = hide y and sh = hide s in
+    do_test "integers" ((-x, x + y, x - y, x * y, x / y, x mod y, x land y, x lor y, x lxor y, x lsl s, x lsr s, x asr s, x = y, x <> y, x < y, x <= y, x > y, x >= y, succ x, pred y)) ((-xh, xh + yh, xh - yh, xh * yh, xh / yh, xh mod yh, xh land yh, xh lor yh, xh lxor yh, xh lsl sh, xh lsr sh, xh asr sh, xh = yh, xh <> yh, xh < yh, xh <= yh, xh > yh, xh >= yh, succ xh, pred yh))
+  end;
+  begin
+    let x = 3.141592654 and y = 0.341638588598232096 in
+    let xh = hide x and yh = hide y in
+    do_test "floats" ((int_of_float x, x +. y, x -. y, x *. y, x /. y, x = y, x <> y, x < y, x <= y, x > y, x >= y)) ((int_of_float xh, xh +. yh, xh -. yh, xh *. yh, xh /. yh, xh = yh, xh <> yh, xh < yh, xh <= yh, xh > yh, xh >= yh))
+  end;
+  begin
+    let x = 781944104l and y = 308219921l and s = 3 in
+    let xh = hide x and yh = hide y and sh = hide s in
+    do_test "32-bit integers" (Int32.(neg x, add x y, sub x y, mul x y, div x y, rem x y, logand x y, logor x y, logxor x y, shift_left x s, shift_right x s, shift_right_logical x s, x = y, x <> y, x < y, x <= y, x > y, x >= y)) (Int32.(neg xh, add xh yh, sub xh yh, mul xh yh, div xh yh, rem xh yh, logand xh yh, logor xh yh, logxor xh yh, shift_left xh sh, shift_right xh sh, shift_right_logical xh sh, xh = yh, xh <> yh, xh < yh, xh <= yh, xh > yh, xh >= yh))
+  end;
+  begin
+    let x = 1828697041n and y = -521695949n and s = 8 in
+    let xh = hide x and yh = hide y and sh = hide s in
+    do_test "native integers" (Nativeint.(neg x, add x y, sub x y, mul x y, div x y, rem x y, logand x y, logor x y, logxor x y, shift_left x s, shift_right x s, shift_right_logical x s, x = y, x <> y, x < y, x <= y, x > y, x >= y)) (Nativeint.(neg xh, add xh yh, sub xh yh, mul xh yh, div xh yh, rem xh yh, logand xh yh, logor xh yh, logxor xh yh, shift_left xh sh, shift_right xh sh, shift_right_logical xh sh, xh = yh, xh <> yh, xh < yh, xh <= yh, xh > yh, xh >= yh))
+  end;
+  begin
+    let x = 1511491586921138079L and y = 6677538715441746158L and s = 17 in
+    let xh = hide x and yh = hide y and sh = hide s in
+    do_test "64-bit integers" (Int64.(neg x, add x y, sub x y, mul x y, div x y, rem x y, logand x y, logor x y, logxor x y, shift_left x s, shift_right x s, shift_right_logical x s, x = y, x <> y, x < y, x <= y, x > y, x >= y)) (Int64.(neg xh, add xh yh, sub xh yh, mul xh yh, div xh yh, rem xh yh, logand xh yh, logor xh yh, logxor xh yh, shift_left xh sh, shift_right xh sh, shift_right_logical xh sh, xh = yh, xh <> yh, xh < yh, xh <= yh, xh > yh, xh >= yh))
+  end;
+  begin
+    let x = 1000807289 in
+    let xh = hide x in
+    do_test "integer conversions" ((float_of_int x, Int32.of_int x, Nativeint.of_int x, Int64.of_int x)) ((float_of_int xh, Int32.of_int xh, Nativeint.of_int xh, Int64.of_int xh))
+  end;
+  begin
+    let x = 10486393l in
+    let xh = hide x in
+    do_test "32-bit integer conversions" ((Int32.to_int x, Nativeint.of_int32 x, Int64.of_int32 x)) ((Int32.to_int xh, Nativeint.of_int32 xh, Int64.of_int32 xh))
+  end;
+  begin
+    let x = -131134014n in
+    let xh = hide x in
+    do_test "native integer conversions" ((Nativeint.to_int x, Nativeint.to_int32 x, Int64.of_nativeint x)) ((Nativeint.to_int xh, Nativeint.to_int32 xh, Int64.of_nativeint xh))
+  end;
+  begin
+    let x = 531871273453404175L in
+    let xh = hide x in
+    do_test "64-bit integer conversions" ((Int64.to_int x, Int64.to_int32 x, Int64.to_nativeint x)) ((Int64.to_int xh, Int64.to_int32 xh, Int64.to_nativeint xh))
+  end
diff --git a/testsuite/tests/basic/constprop.mlp b/testsuite/tests/basic/constprop.mlp
new file mode 100644
index 0000000000..305a98dd95
--- /dev/null
+++ b/testsuite/tests/basic/constprop.mlp
@@ -0,0 +1,130 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Gallium, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 2014 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.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* Test constant propagation through inlining *)
+
+(* constprop.ml is generated from constprop.mlp using
+      cpp constprop.mlp > constprop.ml
+*)
+
+#define tbool(x,y) \
+  (x && y, x || y, not x)
+
+#define tint(x,y,s)                                                         \
+  (-x, x + y, x - y, x * y, x / y, x mod y,                                 \
+   x land y, x lor y, x lxor y,                                             \
+   x lsl s, x lsr s, x asr s,                                               \
+   x = y, x <> y, x < y, x <= y, x > y, x >= y,                             \
+   succ x, pred y)
+
+#define tfloat(x,y)                                                         \
+  (int_of_float x,                                                          \
+   x +. y, x -. y, x *. y, x /. y,                                          \
+   x = y, x <> y, x < y, x <= y, x > y, x >= y)
+
+#define tconvint(i)                                                         \
+  (float_of_int i,                                                          \
+   Int32.of_int i,                                                          \
+   Nativeint.of_int i,                                                      \
+   Int64.of_int i)
+
+#define tconvint32(i)                                                       \
+  (Int32.to_int i,                                                          \
+   Nativeint.of_int32 i,                                                    \
+   Int64.of_int32 i)
+
+#define tconvnativeint(i)                                                   \
+  (Nativeint.to_int i,                                                      \
+   Nativeint.to_int32 i,                                                    \
+   Int64.of_nativeint i)
+
+#define tconvint64(i)                                                       \
+  (Int64.to_int i,                                                          \
+   Int64.to_int32 i,                                                        \
+   Int64.to_nativeint i)                                                    \
+
+#define tint32(x,y,s)                                                       \
+  Int32.(neg x, add x y, sub x y, mul x y, div x y, rem x y,                \
+         logand x y, logor x y, logxor x y,                                 \
+         shift_left x s, shift_right x s, shift_right_logical x s,          \
+         x = y, x <> y, x < y, x <= y, x > y, x >= y)
+  
+#define tnativeint(x,y,s)                                                   \
+  Nativeint.(neg x, add x y, sub x y, mul x y, div x y, rem x y,            \
+         logand x y, logor x y, logxor x y,                                 \
+         shift_left x s, shift_right x s, shift_right_logical x s,          \
+         x = y, x <> y, x < y, x <= y, x > y, x >= y)
+
+#define tint64(x,y,s)                                                       \
+  Int64.(neg x, add x y, sub x y, mul x y, div x y, rem x y,                \
+         logand x y, logor x y, logxor x y,                                 \
+         shift_left x s, shift_right x s, shift_right_logical x s,          \
+         x = y, x <> y, x < y, x <= y, x > y, x >= y)
+  
+let do_test msg res1 res2 =
+  Printf.printf "%s: %s\n" msg (if res1 = res2 then "passed" else "FAILED")
+
+(* Hide a constant from the optimizer, preventing constant propagation *)
+let hide x = List.nth [x] 0
+
+let _ =
+  begin
+    let x = true and y = false in
+    let xh = hide x and yh = hide y in
+    do_test "booleans" (tbool(x, y)) (tbool(xh,yh))
+  end;
+  begin
+    let x = 89809344 and y = 457455773 and s = 7 in
+    let xh = hide x and yh = hide y and sh = hide s in
+    do_test "integers" (tint(x, y, s)) (tint(xh,yh,sh))
+  end;
+  begin
+    let x = 3.141592654 and y = 0.341638588598232096 in
+    let xh = hide x and yh = hide y in
+    do_test "floats" (tfloat(x, y)) (tfloat(xh, yh))
+  end;
+  begin
+    let x = 781944104l and y = 308219921l and s = 3 in
+    let xh = hide x and yh = hide y and sh = hide s in
+    do_test "32-bit integers" (tint32(x, y, s)) (tint32(xh, yh, sh))
+  end;
+  begin
+    let x = 1828697041n and y = -521695949n and s = 8 in
+    let xh = hide x and yh = hide y and sh = hide s in
+    do_test "native integers" (tnativeint(x, y, s)) (tnativeint(xh, yh, sh))
+  end;
+  begin
+    let x = 1511491586921138079L and y = 6677538715441746158L and s = 17 in
+    let xh = hide x and yh = hide y and sh = hide s in
+    do_test "64-bit integers" (tint64(x, y, s)) (tint64(xh, yh, sh))
+  end;
+  begin
+    let x = 1000807289 in
+    let xh = hide x in
+    do_test "integer conversions" (tconvint(x)) (tconvint(xh))
+  end;
+  begin
+    let x = 10486393l in
+    let xh = hide x in
+    do_test "32-bit integer conversions" (tconvint32(x)) (tconvint32(xh))
+  end;
+  begin
+    let x = -131134014n in
+    let xh = hide x in
+    do_test "native integer conversions" (tconvnativeint(x)) (tconvnativeint(xh))
+  end;
+  begin
+    let x = 531871273453404175L in
+    let xh = hide x in
+    do_test "64-bit integer conversions" (tconvint64(x)) (tconvint64(xh))
+  end
+
diff --git a/testsuite/tests/basic/constprop.reference b/testsuite/tests/basic/constprop.reference
new file mode 100644
index 0000000000..59590530ae
--- /dev/null
+++ b/testsuite/tests/basic/constprop.reference
@@ -0,0 +1,10 @@
+booleans: passed
+integers: passed
+floats: passed
+32-bit integers: passed
+native integers: passed
+64-bit integers: passed
+integer conversions: passed
+32-bit integer conversions: passed
+native integer conversions: passed
+64-bit integer conversions: passed
diff --git a/testsuite/tests/basic/tailcalls.ml b/testsuite/tests/basic/tailcalls.ml
index 9a9293aef8..4b33206ee3 100644
--- a/testsuite/tests/basic/tailcalls.ml
+++ b/testsuite/tests/basic/tailcalls.ml
@@ -32,6 +32,15 @@ let indtailcall8 fn a b c d e f g h =
 let indtailcall16 fn a b c d e f g h i j k l m n o p =
   fn a b c d e f g h i j k l m n o p
 
+(* regression test for PR#6441: *)
+let rec tailcall16_value_closures a b c d e f g h i j k l m n o p =
+  if a < 0
+  then b
+  else tailcall16_value_closures
+         (a-1) (b+1) (c+2) (d+3) (e+4) (f+5) (g+6) (h+7)
+         (i+8) (j+9) (k+10) (l+11) (m+12) (n+13) (o+14) (p+15)
+and fs = [tailcall16_value_closures]
+
 let _ =
   print_int (tailcall4 10000000 0 0 0); print_newline();
   print_int (tailcall8 10000000 0 0 0 0 0 0 0); print_newline();
@@ -39,4 +48,6 @@ let _ =
   print_newline();
   print_int (indtailcall8 tailcall8 10 0 0 0 0 0 0 0); print_newline();
   print_int (indtailcall16 tailcall16 10 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0);
+  print_newline();
+  print_int (tailcall16_value_closures 10000000 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0);
   print_newline()
diff --git a/testsuite/tests/basic/tailcalls.reference b/testsuite/tests/basic/tailcalls.reference
index 0943aba55e..c7117bc954 100644
--- a/testsuite/tests/basic/tailcalls.reference
+++ b/testsuite/tests/basic/tailcalls.reference
@@ -3,3 +3,4 @@
 10000001
 11
 11
+10000001
diff --git a/testsuite/tests/embedded/cmcaml.ml b/testsuite/tests/embedded/cmcaml.ml
index 121cec36fe..b3e9b7e29d 100644
--- a/testsuite/tests/embedded/cmcaml.ml
+++ b/testsuite/tests/embedded/cmcaml.ml
@@ -18,7 +18,7 @@ let rec fib n =
 let format_result n =
   let r = "Result = " ^ string_of_int n in
   (* Allocate gratuitously to test GC *)
-  for i = 1 to 1500 do ignore (String.create 256) done;
+  for i = 1 to 1500 do ignore (Bytes.create 256) done;
   r
 
 (* Registration *)
diff --git a/testsuite/tests/formats-transition/Makefile b/testsuite/tests/formats-transition/Makefile
new file mode 100644
index 0000000000..9625a3fbc3
--- /dev/null
+++ b/testsuite/tests/formats-transition/Makefile
@@ -0,0 +1,3 @@
+BASEDIR=../..
+include $(BASEDIR)/makefiles/Makefile.toplevel
+include $(BASEDIR)/makefiles/Makefile.common
diff --git a/testsuite/tests/formats-transition/deprecated_unsigned_printers.ml b/testsuite/tests/formats-transition/deprecated_unsigned_printers.ml
new file mode 100644
index 0000000000..3127d773af
--- /dev/null
+++ b/testsuite/tests/formats-transition/deprecated_unsigned_printers.ml
@@ -0,0 +1,22 @@
+(* %n, %l, %N and %L have a scanf-specific semantics, but are supposed
+   to be interpreted by Printf and Format as %u, despite this
+   interpretation being mildly deprecated *)
+
+let test format = (Printf.sprintf format (-3) : string)
+;;
+
+let () = Printf.printf "%%n: %B\n"
+  (test "%n" = test "%u")
+;;
+
+let () = Printf.printf "%%l: %B\n"
+  (test "%l" = test "%u")
+;;
+
+let () = Printf.printf "%%N: %B\n"
+  (test "%N" = test "%u")
+;;
+
+let () = Printf.printf "%%L: %B\n"
+  (test "%L" = test "%u")
+;;
diff --git a/testsuite/tests/formats-transition/deprecated_unsigned_printers.ml.reference b/testsuite/tests/formats-transition/deprecated_unsigned_printers.ml.reference
new file mode 100644
index 0000000000..0afeaa2be1
--- /dev/null
+++ b/testsuite/tests/formats-transition/deprecated_unsigned_printers.ml.reference
@@ -0,0 +1,7 @@
+
+# * *       val test : (int -> string, unit, string) format -> string = <fun>
+#       %n: true
+#       %l: true
+#       %N: true
+#       %L: true
+# 
diff --git a/testsuite/tests/formats-transition/ignored_scan_counters.ml b/testsuite/tests/formats-transition/ignored_scan_counters.ml
new file mode 100644
index 0000000000..706a1af6f9
--- /dev/null
+++ b/testsuite/tests/formats-transition/ignored_scan_counters.ml
@@ -0,0 +1,30 @@
+(* Benoît's patch did not support %_[nlNL]; test their behavior *)
+
+(* not supported by Printf or Format: fails at runtime *)
+let () = Printf.printf "%_n"
+;;
+let () = Printf.printf "%_N"
+;;
+let () = Printf.printf "%_l"
+;;
+let () = Printf.printf "%_L"
+;;
+
+let () = Format.printf "%_n"
+;;
+let () = Format.printf "%_N"
+;;
+let () = Format.printf "%_l"
+;;
+let () = Format.printf "%_L"
+;;
+
+(* identity for Scanf *)
+let () = print_endline (Scanf.sscanf "" "%_n" "Hello World!")
+;;
+let () = print_endline (Scanf.sscanf "" "%_N" "Hello World!")
+;;
+let () = print_endline (Scanf.sscanf "" "%_l" "Hello World!")
+;;
+let () = print_endline (Scanf.sscanf "" "%_L" "Hello World!")
+;;
diff --git a/testsuite/tests/formats-transition/ignored_scan_counters.ml.reference b/testsuite/tests/formats-transition/ignored_scan_counters.ml.reference
new file mode 100644
index 0000000000..6d8d098b5a
--- /dev/null
+++ b/testsuite/tests/formats-transition/ignored_scan_counters.ml.reference
@@ -0,0 +1,14 @@
+
+#         Exception: Invalid_argument "Printf: bad conversion %_".
+#   Exception: Invalid_argument "Printf: bad conversion %_".
+#   Exception: Invalid_argument "Printf: bad conversion %_".
+#   Exception: Invalid_argument "Printf: bad conversion %_".
+#     Exception: Invalid_argument "Printf: bad conversion %_".
+#   Exception: Invalid_argument "Printf: bad conversion %_".
+#   Exception: Invalid_argument "Printf: bad conversion %_".
+#   Exception: Invalid_argument "Printf: bad conversion %_".
+#       Hello World!
+#   Hello World!
+#   Hello World!
+#   Hello World!
+# 
diff --git a/testsuite/tests/formats-transition/legacy_incompatible_flags.ml b/testsuite/tests/formats-transition/legacy_incompatible_flags.ml
new file mode 100644
index 0000000000..53cf5c26c7
--- /dev/null
+++ b/testsuite/tests/formats-transition/legacy_incompatible_flags.ml
@@ -0,0 +1,20 @@
+(* the legacy parser ignores flags on formatters on which they make no
+   sense *)
+
+let () = Printf.printf "%+s\n" "toto"
+;;
+let () = Printf.printf "%#s\n" "toto"
+;;
+let () = Printf.printf "% s\n" "toto"
+;;
+let () = Printf.printf "%03s\n" "toto"
+;;
+let () = Printf.printf "%03S\n" "toto"
+;;
+let () = Printf.printf "%.3s\n" "toto"
+;;
+
+(* it still fails on flags used with ignored formats (%_d, etc.),
+   but it's unclear how to test that in a backward-compatible way,
+   if we accept that the error message may have changed
+*)
diff --git a/testsuite/tests/formats-transition/legacy_unfinished_modifiers.ml b/testsuite/tests/formats-transition/legacy_unfinished_modifiers.ml
new file mode 100644
index 0000000000..16eca40c17
--- /dev/null
+++ b/testsuite/tests/formats-transition/legacy_unfinished_modifiers.ml
@@ -0,0 +1,18 @@
+(* test whether padding modifiers are accepted without any padding
+   size
+
+   the precision modifier is accepted without precision setting, but it
+   defaults to 0, which is not the same thing as not having precision:
+     %.0f 3.5 => 3
+     %.f 3.5 => 3
+     %f  3.5 => 3.5
+*)
+
+let () = Printf.printf "%0d\n" 3
+;;
+let () = Printf.printf "%-d\n" 3
+;;
+let () = Printf.printf "%.d\n" 3
+;;
+let () = Printf.printf "%.f\n" 3.
+;;
diff --git a/testsuite/tests/formats-transition/legacy_unfinished_modifiers.ml.reference b/testsuite/tests/formats-transition/legacy_unfinished_modifiers.ml.reference
new file mode 100644
index 0000000000..81c05c0dd5
--- /dev/null
+++ b/testsuite/tests/formats-transition/legacy_unfinished_modifiers.ml.reference
@@ -0,0 +1,6 @@
+
+# * * * * * * * *       3
+#   3
+#   3
+#   3
+# 
diff --git a/testsuite/tests/gc-roots/globrootsprim.c b/testsuite/tests/gc-roots/globrootsprim.c
index 9a1cc843a1..f7bb32ceab 100644
--- a/testsuite/tests/gc-roots/globrootsprim.c
+++ b/testsuite/tests/gc-roots/globrootsprim.c
@@ -16,10 +16,12 @@
 #include "mlvalues.h"
 #include "memory.h"
 #include "alloc.h"
+#include "gc.h"
 
-struct block { value v; };
+struct block { value header; value v; };
 
-#define Block_val(v) ((struct block *) (v))
+#define Block_val(v) ((struct block*) &((value*) v)[-1])
+#define Val_block(b) ((value) &((b)->v))
 
 value gb_get(value vblock)
 {
@@ -29,9 +31,10 @@ value gb_get(value vblock)
 value gb_classic_register(value v)
 {
   struct block * b = caml_stat_alloc(sizeof(struct block));
+  b->header = Make_header(1, 0, Caml_black);
   b->v = v;
   caml_register_global_root(&(b->v));
-  return (value) b;
+  return Val_block(b);
 }
 
 value gb_classic_set(value vblock, value newval)
@@ -49,9 +52,10 @@ value gb_classic_remove(value vblock)
 value gb_generational_register(value v)
 {
   struct block * b = caml_stat_alloc(sizeof(struct block));
+  b->header = Make_header(1, 0, Caml_black);
   b->v = v;
   caml_register_generational_global_root(&(b->v));
-  return (value) b;
+  return Val_block(b);
 }
 
 value gb_generational_set(value vblock, value newval)
diff --git a/testsuite/tests/lib-format/Makefile b/testsuite/tests/lib-format/Makefile
index 0b385ca4bb..7a6297b6f4 100644
--- a/testsuite/tests/lib-format/Makefile
+++ b/testsuite/tests/lib-format/Makefile
@@ -14,5 +14,7 @@ MAIN_MODULE=tformat
 ADD_COMPFLAGS=-I $(OTOPDIR)/testsuite/lib
 ADD_MODULES=testing
 
-include ../../makefiles/Makefile.one
-include ../../makefiles/Makefile.common
+BASEDIR=../..
+
+include $(BASEDIR)/makefiles/Makefile.one
+include $(BASEDIR)/makefiles/Makefile.common
diff --git a/testsuite/tests/lib-marshal/intext.ml b/testsuite/tests/lib-marshal/intext.ml
index 06f169e0bb..27ffd64d24 100644
--- a/testsuite/tests/lib-marshal/intext.ml
+++ b/testsuite/tests/lib-marshal/intext.ml
@@ -249,77 +249,77 @@ let marshal_to_buffer s start len v flags =
 ;;
 
 let test_buffer () =
-  let s = String.create 512 in
+  let s = Bytes.create 512 in
   marshal_to_buffer s 0 512 1 [];
-  test 201 (Marshal.from_string s 0 = 1);
+  test 201 (Marshal.from_bytes s 0 = 1);
   marshal_to_buffer s 0 512 (-1) [];
-  test 202 (Marshal.from_string s 0 = (-1));
+  test 202 (Marshal.from_bytes s 0 = (-1));
   marshal_to_buffer s 0 512 258 [];
-  test 203 (Marshal.from_string s 0 = 258);
+  test 203 (Marshal.from_bytes s 0 = 258);
   marshal_to_buffer s 0 512 20000 [];
-  test 204 (Marshal.from_string s 0 = 20000);
+  test 204 (Marshal.from_bytes s 0 = 20000);
   marshal_to_buffer s 0 512 0x12345678 [];
-  test 205 (Marshal.from_string s 0 = 0x12345678);
+  test 205 (Marshal.from_bytes s 0 = 0x12345678);
   marshal_to_buffer s 0 512 bigint [];
-  test 206 (Marshal.from_string s 0 = bigint);
+  test 206 (Marshal.from_bytes s 0 = bigint);
   marshal_to_buffer s 0 512 "foobargeebuz" [];
-  test 207 (Marshal.from_string s 0 = "foobargeebuz");
+  test 207 (Marshal.from_bytes s 0 = "foobargeebuz");
   marshal_to_buffer s 0 512 longstring [];
-  test 208 (Marshal.from_string s 0 = longstring);
+  test 208 (Marshal.from_bytes s 0 = longstring);
   test 209
     (try marshal_to_buffer s 0 512 verylongstring []; false
      with Failure "Marshal.to_buffer: buffer overflow" -> true);
   marshal_to_buffer s 0 512 3.141592654 [];
-  test 210 (Marshal.from_string s 0 = 3.141592654);
+  test 210 (Marshal.from_bytes s 0 = 3.141592654);
   marshal_to_buffer s 0 512 () [];
-  test 211 (Marshal.from_string s 0 = ());
+  test 211 (Marshal.from_bytes s 0 = ());
   marshal_to_buffer s 0 512 A [];
-  test 212 (match Marshal.from_string s 0 with
+  test 212 (match Marshal.from_bytes s 0 with
     A -> true
   | _ -> false);
   marshal_to_buffer s 0 512 (B 1) [];
-  test 213 (match Marshal.from_string s 0 with
+  test 213 (match Marshal.from_bytes s 0 with
     (B 1) -> true
   | _ -> false);
   marshal_to_buffer s 0 512 (C 2.718) [];
-  test 214 (match Marshal.from_string s 0 with
+  test 214 (match Marshal.from_bytes s 0 with
     (C f) -> f = 2.718
   | _ -> false);
   marshal_to_buffer s 0 512 (D "hello, world!") [];
-  test 215 (match Marshal.from_string s 0 with
+  test 215 (match Marshal.from_bytes s 0 with
     (D "hello, world!") -> true
   | _ -> false);
   marshal_to_buffer s 0 512 (E 'l') [];
-  test 216 (match Marshal.from_string s 0 with
+  test 216 (match Marshal.from_bytes s 0 with
     (E 'l') -> true
   | _ -> false);
   marshal_to_buffer s 0 512 (F(B 1)) [];
-  test 217 (match Marshal.from_string s 0 with
+  test 217 (match Marshal.from_bytes s 0 with
     (F(B 1)) -> true
   | _ -> false);
   marshal_to_buffer s 0 512 (G(A, G(B 2, G(C 3.14, G(D "glop", E 'e'))))) [];
-  test 218 (match Marshal.from_string s 0 with
+  test 218 (match Marshal.from_bytes s 0 with
     (G(A, G(B 2, G(C 3.14, G(D "glop", E 'e'))))) -> true
   | _ -> false);
   marshal_to_buffer s 0 512 (H(1, A)) [];
-  test 219 (match Marshal.from_string s 0 with
+  test 219 (match Marshal.from_bytes s 0 with
     (H(1, A)) -> true
   | _ -> false);
   marshal_to_buffer s 0 512 (I(B 2, 1e-6)) [];
-  test 220 (match Marshal.from_string s 0 with
+  test 220 (match Marshal.from_bytes s 0 with
     (I(B 2, 1e-6)) -> true
   | _ -> false);
   let x = D "sharing" in
   let y = G(x, x) in
   let z = G(y, G(x, y)) in
   marshal_to_buffer s 0 512 z [];
-  test 221 (match Marshal.from_string s 0 with
+  test 221 (match Marshal.from_bytes s 0 with
     G((G((D "sharing" as t1), t2) as t3), G(t4, t5)) ->
       t1 == t2 && t3 == t5 && t4 == t1
   | _ -> false);
   marshal_to_buffer s 0 512 [|1;2;3;4;5;6;7;8;9;10;11;12;13;14;15;16|] [];
   test 222
-       (Marshal.from_string s 0 = [|1;2;3;4;5;6;7;8;9;10;11;12;13;14;15;16|]);
+       (Marshal.from_bytes s 0 = [|1;2;3;4;5;6;7;8;9;10;11;12;13;14;15;16|]);
   let rec big n = if n <= 0 then A else H(n, big(n-1)) in
   test 223
     (try marshal_to_buffer s 0 512 (big 1000) []; false
diff --git a/testsuite/tests/lib-printf/Makefile b/testsuite/tests/lib-printf/Makefile
index a8a2947182..dc31633e11 100644
--- a/testsuite/tests/lib-printf/Makefile
+++ b/testsuite/tests/lib-printf/Makefile
@@ -15,5 +15,6 @@ MAIN_MODULE=tprintf
 ADD_COMPFLAGS=-I $(OTOPDIR)/testsuite/lib
 ADD_MODULES=testing
 
-include ../../makefiles/Makefile.one
-include ../../makefiles/Makefile.common
+BASEDIR=../..
+include $(BASEDIR)/makefiles/Makefile.one
+include $(BASEDIR)/makefiles/Makefile.common
diff --git a/testsuite/tests/lib-printf/tprintf.ml b/testsuite/tests/lib-printf/tprintf.ml
index 47313b325a..2922f8e325 100644
--- a/testsuite/tests/lib-printf/tprintf.ml
+++ b/testsuite/tests/lib-printf/tprintf.ml
@@ -27,10 +27,12 @@ try
   test (sprintf "%04d/%05i" 42 43 = "0042/00043");
   test (sprintf "%+d/%+i" 42 43 = "+42/+43");
   test (sprintf "% d/% i" 42 43 = " 42/ 43");
-  test (sprintf "%#d/%#i" 42 43 = "42/43");
+  (*test (sprintf "%#d/%#i" 42 43 = "42/43");*)
+    (* >> '#' is incompatible with 'd' *)
   test (sprintf "%4d/%5i" 42 43 = "  42/   43");
   test (sprintf "%*d/%*i" 4 42 5 43 = "  42/   43");
-  test (sprintf "%-0+#4d/%-0 #5i" 42 43 = "+42 / 43  ");
+  (*test (sprintf "%-0+#4d/%-0 #5i" 42 43 = "+42 / 43  ");*)
+    (* >> '#' is incompatible with 'd' *)
 
   printf "\nd/i negative\n%!";
   test (sprintf "%d/%i" (-42) (-43) = "-42/-43");
@@ -38,21 +40,27 @@ try
   test (sprintf "%04d/%05i" (-42) (-43) = "-042/-0043");
   test (sprintf "%+d/%+i" (-42) (-43) = "-42/-43");
   test (sprintf "% d/% i" (-42) (-43) = "-42/-43");
-  test (sprintf "%#d/%#i" (-42) (-43) = "-42/-43");
+  (*test (sprintf "%#d/%#i" (-42) (-43) = "-42/-43");*)
+    (* >> '#' is incompatible with 'd' *)
   test (sprintf "%4d/%5i" (-42) (-43) = " -42/  -43");
   test (sprintf "%*d/%*i" 4 (-42) 5 (-43) = " -42/  -43");
-  test (sprintf "%-0+ #4d/%-0+ #5i" (-42) (-43) = "-42 /-43  ");
+  (*test (sprintf "%-0+ #4d/%-0+ #5i" (-42) (-43) = "-42 /-43  ");*)
+    (* >> '0' is incompatible with '-', '#' is incompatible with 'd' *)
 
   printf "\nu positive\n%!";
   test (sprintf "%u" 42 = "42");
   test (sprintf "%-4u" 42 = "42  ");
   test (sprintf "%04u" 42 = "0042");
-  test (sprintf "%+u" 42 = "42");
-  test (sprintf "% u" 42 = "42");
-  test (sprintf "%#u" 42 = "42");
+  (*test (sprintf "%+u" 42 = "42");*)
+    (* >> '+' is incompatible with 'u' *)
+  (*test (sprintf "% u" 42 = "42");*)
+    (* >> ' ' is incompatible with 'u' *)
+  (*test (sprintf "%#u" 42 = "42");*)
+    (* >> '#' is incompatible with 'u' *)
   test (sprintf "%4u" 42 = "  42");
   test (sprintf "%*u" 4 42 = "  42");
-  test (sprintf "%-0+ #6d" 42 = "+42   ");
+  (*test (sprintf "%-0+ #6d" 42 = "+42   ");*)
+    (* >> '-' is incompatible with '0', '#' is incompatible with 'd' *)
 
   printf "\nu negative\n%!";
   begin match Sys.word_size with
@@ -67,12 +75,15 @@ try
   test (sprintf "%x" 42 = "2a");
   test (sprintf "%-4x" 42 = "2a  ");
   test (sprintf "%04x" 42 = "002a");
-  test (sprintf "%+x" 42 = "2a");
-  test (sprintf "% x" 42 = "2a");
+  (*test (sprintf "%+x" 42 = "2a");*)
+    (* >> '+' is incompatible with 'x' *)
+  (*test (sprintf "% x" 42 = "2a");*)
+    (* >> ' ' is incompatible with 'x' *)
   test (sprintf "%#x" 42 = "0x2a");
   test (sprintf "%4x" 42 = "  2a");
   test (sprintf "%*x" 5 42 = "   2a");
-  test (sprintf "%-0+ #*x" 5 42 = "0x2a ");
+  (*test (sprintf "%-0+ #*x" 5 42 = "0x2a ");*)
+    (* >> '-' is incompatible with '0' *)
 
   printf "\nx negative\n%!";
   begin match Sys.word_size with
@@ -87,12 +98,15 @@ try
   test (sprintf "%X" 42 = "2A");
   test (sprintf "%-4X" 42 = "2A  ");
   test (sprintf "%04X" 42 = "002A");
-  test (sprintf "%+X" 42 = "2A");
-  test (sprintf "% X" 42 = "2A");
+  (*test (sprintf "%+X" 42 = "2A");*)
+    (* >> '+' is incompatible with 'X' *)
+  (*test (sprintf "% X" 42 = "2A");*)
+    (* >> ' ' is incompatible with 'X' *)
   test (sprintf "%#X" 42 = "0X2A");
   test (sprintf "%4X" 42 = "  2A");
   test (sprintf "%*X" 5 42 = "   2A");
-  test (sprintf "%-0+ #*X" 5 42 = "0X2A ");
+  (*test (sprintf "%-0+ #*X" 5 42 = "0X2A ");*)
+    (* >> '-' is incompatible with '0' *)
 
   printf "\nx negative\n%!";
   begin match Sys.word_size with
@@ -107,12 +121,15 @@ try
   test (sprintf "%o" 42 = "52");
   test (sprintf "%-4o" 42 = "52  ");
   test (sprintf "%04o" 42 = "0052");
-  test (sprintf "%+o" 42 = "52");
-  test (sprintf "% o" 42 = "52");
+  (*test (sprintf "%+o" 42 = "52");*)
+    (* >> '+' is incompatible with 'o' *)
+  (*test (sprintf "% o" 42 = "52");*)
+    (* >> '+' is incompatible with 'o' *)
   test (sprintf "%#o" 42 = "052");
   test (sprintf "%4o" 42 = "  52");
   test (sprintf "%*o" 5 42 = "   52");
-  test (sprintf "%-0+ #*o" 5 42 = "052  ");
+  (*test (sprintf "%-0+ #*o" 5 42 = "052  ");*)
+    (* >> '-' is incompatible with 'o' *)
 
   printf "\no negative\n%!";
   begin match Sys.word_size with
@@ -126,15 +143,20 @@ try
   printf "\ns\n%!";
   test (sprintf "%s" "foo" = "foo");
   test (sprintf "%-5s" "foo" = "foo  ");
-  test (sprintf "%05s" "foo" = "  foo");
-  test (sprintf "%+s" "foo" = "foo");
-  test (sprintf "% s" "foo" = "foo");
-  test (sprintf "%#s" "foo" = "foo");
+  (*test (sprintf "%05s" "foo" = "  foo");*)
+    (* >> '0' is incompatible with 's' *)
+  (*test (sprintf "%+s" "foo" = "foo");*)
+    (* >> '+' is incompatible with 's' *)
+  (*test (sprintf "% s" "foo" = "foo");*)
+    (* >> ' ' is incompatible with 's' *)
+  (*test (sprintf "%#s" "foo" = "foo");*)
+    (* >> '#' is incompatible with 's' *)
   test (sprintf "%5s" "foo" = "  foo");
   test (sprintf "%1s" "foo" = "foo");
   test (sprintf "%*s" 6 "foo" = "   foo");
   test (sprintf "%*s" 2 "foo" = "foo");
-  test (sprintf "%-0+ #5s" "foo" = "foo  ");
+  (*test (sprintf "%-0+ #5s" "foo" = "foo  ");*)
+    (* >> '-' is incompatible with '0', '#' is incompatible with 's' *)
   test (sprintf "%s@" "foo" = "foo@");
   test (sprintf "%s@inria.fr" "foo" = "foo@inria.fr");
   test (sprintf "%s@%s" "foo" "inria.fr" = "foo@inria.fr");
@@ -143,9 +165,12 @@ try
   test (sprintf "%S" "fo\"o" = "\"fo\\\"o\"");
 (*  test (sprintf "%-5S" "foo" = "\"foo\"  ");   padding not done *)
 (*  test (sprintf "%05S" "foo" = "  \"foo\"");   padding not done *)
-  test (sprintf "%+S" "foo" = "\"foo\"");
-  test (sprintf "% S" "foo" = "\"foo\"");
-  test (sprintf "%#S" "foo" = "\"foo\"");
+  (*test (sprintf "%+S" "foo" = "\"foo\"");*)
+    (* >> '#' is incompatible with 'S' *)
+  (*test (sprintf "% S" "foo" = "\"foo\"");*)
+    (* >> '#' is incompatible with 'S' *)
+  (*test (sprintf "%#S" "foo" = "\"foo\"");*)
+    (* >> '#' is incompatible with 'S' *)
 (*  test (sprintf "%5S" "foo" = "  \"foo\"");    padding not done *)
   test (sprintf "%1S" "foo" = "\"foo\"");
 (*  test (sprintf "%*S" 6 "foo" = "   \"foo\"");  padding not done *)
@@ -159,9 +184,12 @@ try
   test (sprintf "%c" 'c' = "c");
 (*  test (sprintf "%-4c" 'c' = "c   ");    padding not done *)
 (*  test (sprintf "%04c" 'c' = "   c");    padding not done *)
-  test (sprintf "%+c" 'c' = "c");
-  test (sprintf "% c" 'c' = "c");
-  test (sprintf "%#c" 'c' = "c");
+  (*test (sprintf "%+c" 'c' = "c");*)
+    (* >> '#' is incompatible with 'c' *)
+  (*test (sprintf "% c" 'c' = "c");*)
+    (* >> '#' is incompatible with 'c' *)
+  (*test (sprintf "%#c" 'c' = "c");*)
+    (* >> '#' is incompatible with 'c' *)
 (*  test (sprintf "%4c" 'c' = "   c");     padding not done *)
 (*  test (sprintf "%*c" 2 'c' = " c");     padding not done *)
 (*  test (sprintf "%-0+ #4c" 'c' = "c   ");  padding not done *)
@@ -171,12 +199,15 @@ try
   test (sprintf "%C" '\'' = "'\\''");
 (*  test (sprintf "%-4C" 'c' = "c   ");    padding not done *)
 (*  test (sprintf "%04C" 'c' = "   c");    padding not done *)
-  test (sprintf "%+C" 'c' = "'c'");
-  test (sprintf "% C" 'c' = "'c'");
-  test (sprintf "%#C" 'c' = "'c'");
-(*  test (sprintf "%4C" 'c' = " 'c'");     padding not done *)
-(*  test (sprintf "%*C" 2 'c' = "'c'");     padding not done *)
-(*  test (sprintf "%-0+ #4C" 'c' = "'c' ");  padding not done *)
+  (*test (sprintf "%+C" 'c' = "'c'");*)
+    (* >> '+' is incompatible with 'C' *)
+  (*test (sprintf "% C" 'c' = "'c'");*)
+    (* >> ' ' is incompatible with 'C' *)
+  (*test (sprintf "%#C" 'c' = "'c'");*)
+    (* >> '#' is incompatible with 'C' *)
+(*  test (sprintf "%4C" 'c' = "   c");     padding not done *)
+(*  test (sprintf "%*C" 2 'c' = " c");     padding not done *)
+(*  test (sprintf "%-0+ #4C" 'c' = "c   ");  padding not done *)
 
   printf "\nf\n%!";
   test (sprintf "%f" (-42.42) = "-42.420000");
@@ -184,19 +215,23 @@ try
   test (sprintf "%013f" (-42.42) = "-00042.420000");
   test (sprintf "%+f" 42.42 = "+42.420000");
   test (sprintf "% f" 42.42 = " 42.420000");
-  test (sprintf "%#f" 42.42 = "42.420000");
+  (*test (sprintf "%#f" 42.42 = "42.420000");*)
+    (* >> '#' is incompatible with 'f' *)
   test (sprintf "%13f" 42.42 = "    42.420000");
   test (sprintf "%*f" 12 42.42 = "   42.420000");
-  test (sprintf "%-0+ #12f" 42.42 = "+42.420000  ");
+  (*test (sprintf "%-0+ #12f" 42.42 = "+42.420000  ");*)
+    (* >> '-' is incompatible with '0', '#' is incompatible with 'f' *)
   test (sprintf "%.3f" (-42.42) = "-42.420");
   test (sprintf "%-13.3f" (-42.42) = "-42.420      ");
   test (sprintf "%013.3f" (-42.42) = "-00000042.420");
   test (sprintf "%+.3f" 42.42 = "+42.420");
   test (sprintf "% .3f" 42.42 = " 42.420");
-  test (sprintf "%#.3f" 42.42 = "42.420");
+  (*test (sprintf "%#.3f" 42.42 = "42.420");*)
+    (* >> '#' is incompatible with 'f' *)
   test (sprintf "%13.3f" 42.42 = "       42.420");
   test (sprintf "%*.*f" 12 3 42.42 = "      42.420");
-  test (sprintf "%-0+ #12.3f" 42.42 = "+42.420     ");
+  (*test (sprintf "%-0+ #12.3f" 42.42 = "+42.420     ");*)
+    (* >> '-' is incompatible with '0', '#' is incompatible with 'f' *)
 
   (* Under Windows (mingw and maybe also MSVC), the stdlib uses three
      digits for the exponent instead of the two used by Linux and BSD.
@@ -240,19 +275,23 @@ try
   test (sprintf "%015e" (-42.42) =* "-004.242000e+01");
   test (sprintf "%+e" 42.42 =* "+4.242000e+01");
   test (sprintf "% e" 42.42 =* " 4.242000e+01");
-  test (sprintf "%#e" 42.42 =* "4.242000e+01");
+  (*test (sprintf "%#e" 42.42 =* "4.242000e+01");*)
+    (* >> '#' is incompatible with 'e' *)
   test (sprintf "%15e" 42.42 =* "   4.242000e+01");
   test (sprintf "%*e" 14 42.42 =* "  4.242000e+01");
-  test (sprintf "%-0+ #14e" 42.42 =* "+4.242000e+01 ");
+  (*test (sprintf "%-0+ #14e" 42.42 =* "+4.242000e+01 ");*)
+    (* >> '-' is incompatible with '0', '#' is incompatible with 'e' *)
   test (sprintf "%.3e" (-42.42) =* "-4.242e+01");
   test (sprintf "%-15.3e" (-42.42) =* "-4.242e+01     ");
   test (sprintf "%015.3e" (-42.42) =* "-000004.242e+01");
   test (sprintf "%+.3e" 42.42 =* "+4.242e+01");
   test (sprintf "% .3e" 42.42 =* " 4.242e+01");
-  test (sprintf "%#.3e" 42.42 =* "4.242e+01");
+  (*test (sprintf "%#.3e" 42.42 =* "4.242e+01");*)
+    (* >> '#' is incompatible with 'e' *)
   test (sprintf "%15.3e" 42.42 =* "      4.242e+01");
   test (sprintf "%*.*e" 11 3 42.42 =* "  4.242e+01");
-  test (sprintf "%-0+ #14.3e" 42.42 =* "+4.242e+01    ");
+  (*test (sprintf "%-0+ #14.3e" 42.42 =* "+4.242e+01    ");*)
+    (* >> '-' is incompatible with '0', '#' is incompatible with 'e' *)
 
   printf "\nE\n%!";
   test (sprintf "%E" (-42.42) =* "-4.242000E+01");
@@ -260,19 +299,23 @@ try
   test (sprintf "%015E" (-42.42) =* "-004.242000E+01");
   test (sprintf "%+E" 42.42 =* "+4.242000E+01");
   test (sprintf "% E" 42.42 =* " 4.242000E+01");
-  test (sprintf "%#E" 42.42 =* "4.242000E+01");
+  (*test (sprintf "%#E" 42.42 =* "4.242000E+01");*)
+    (* >> '#' is incompatible with 'E' *)
   test (sprintf "%15E" 42.42 =* "   4.242000E+01");
   test (sprintf "%*E" 14 42.42 =* "  4.242000E+01");
-  test (sprintf "%-0+ #14E" 42.42 =* "+4.242000E+01 ");
+  (*test (sprintf "%-0+ #14E" 42.42 =* "+4.242000E+01 ");*)
+    (* >> '#' is incompatible with 'E' *)
   test (sprintf "%.3E" (-42.42) =* "-4.242E+01");
   test (sprintf "%-15.3E" (-42.42) =* "-4.242E+01     ");
   test (sprintf "%015.3E" (-42.42) =* "-000004.242E+01");
   test (sprintf "%+.3E" 42.42 =* "+4.242E+01");
   test (sprintf "% .3E" 42.42 =* " 4.242E+01");
-  test (sprintf "%#.3E" 42.42 =* "4.242E+01");
+  (*test (sprintf "%#.3E" 42.42 =* "4.242E+01");*)
+    (* >> '#' is incompatible with 'E' *)
   test (sprintf "%15.3E" 42.42 =* "      4.242E+01");
   test (sprintf "%*.*E" 11 3 42.42 =* "  4.242E+01");
-  test (sprintf "%-0+ #14.3E" 42.42 =* "+4.242E+01    ");
+  (*test (sprintf "%-0+ #14.3E" 42.42 =* "+4.242E+01    ");*)
+    (* >> '-' is incompatible with '0', '#' is incompatible with 'E' *)
 
 (* %g gives strange results that correspond to neither %f nor %e
   printf "\ng\n%!";
@@ -302,10 +345,12 @@ try
   test (sprintf "%04ld/%05li" 42l 43l = "0042/00043");
   test (sprintf "%+ld/%+li" 42l 43l = "+42/+43");
   test (sprintf "% ld/% li" 42l 43l = " 42/ 43");
-  test (sprintf "%#ld/%#li" 42l 43l = "42/43");
+  (*test (sprintf "%#ld/%#li" 42l 43l = "42/43");*)
+    (* >> '#' is incompatible with 'ld' *)
   test (sprintf "%4ld/%5li" 42l 43l = "  42/   43");
   test (sprintf "%*ld/%*li" 4 42l 5 43l = "  42/   43");
-  test (sprintf "%-0+#4ld/%-0 #5li" 42l 43l = "+42 / 43  ");
+  (*test (sprintf "%-0+#4ld/%-0 #5li" 42l 43l = "+42 / 43  ");*)
+    (* >> '-' is incompatible with '0', '#' is incompatible with 'ld' *)
 
   printf "\nld/li negative\n%!";
   test (sprintf "%ld/%li" (-42l) (-43l) = "-42/-43");
@@ -313,21 +358,27 @@ try
   test (sprintf "%04ld/%05li" (-42l) (-43l) = "-042/-0043");
   test (sprintf "%+ld/%+li" (-42l) (-43l) = "-42/-43");
   test (sprintf "% ld/% li" (-42l) (-43l) = "-42/-43");
-  test (sprintf "%#ld/%#li" (-42l) (-43l) = "-42/-43");
+  (*test (sprintf "%#ld/%#li" (-42l) (-43l) = "-42/-43");*)
+    (* >> '#' is incompatible with 'ld' *)
   test (sprintf "%4ld/%5li" (-42l) (-43l) = " -42/  -43");
   test (sprintf "%*ld/%*li" 4 (-42l) 5 (-43l) = " -42/  -43");
-  test (sprintf "%-0+ #4ld/%-0+ #5li" (-42l) (-43l) = "-42 /-43  ");
+  (*test (sprintf "%-0+ #4ld/%-0+ #5li" (-42l) (-43l) = "-42 /-43  ");*)
+    (* >> '-' is incompatible with '0', '#' is incompatible with 'ld' *)
 
   printf "\nlu positive\n%!";
   test (sprintf "%lu" 42l = "42");
   test (sprintf "%-4lu" 42l = "42  ");
   test (sprintf "%04lu" 42l = "0042");
-  test (sprintf "%+lu" 42l = "42");
-  test (sprintf "% lu" 42l = "42");
-  test (sprintf "%#lu" 42l = "42");
+  (*test (sprintf "%+lu" 42l = "42");*)
+    (* >> '+' is incompatible with 'lu' *)
+  (*test (sprintf "% lu" 42l = "42");*)
+    (* >> ' ' is incompatible with 'lu' *)
+  (*test (sprintf "%#lu" 42l = "42");*)
+    (* >> '#' is incompatible with 'lu' *)
   test (sprintf "%4lu" 42l = "  42");
   test (sprintf "%*lu" 4 42l = "  42");
-  test (sprintf "%-0+ #6ld" 42l = "+42   ");
+  (*test (sprintf "%-0+ #6ld" 42l = "+42   ");*)
+    (* >> '-' is incompatible with '0', '#' is incompatible with 'ld' *)
 
   printf "\nlu negative\n%!";
   test (sprintf "%lu" (-1l) = "4294967295");
@@ -336,12 +387,15 @@ try
   test (sprintf "%lx" 42l = "2a");
   test (sprintf "%-4lx" 42l = "2a  ");
   test (sprintf "%04lx" 42l = "002a");
-  test (sprintf "%+lx" 42l = "2a");
-  test (sprintf "% lx" 42l = "2a");
+  (*test (sprintf "%+lx" 42l = "2a");*)
+    (* >> '+' is incompatible with 'lx' *)
+  (*test (sprintf "% lx" 42l = "2a");*)
+    (* >> ' ' is incompatible with 'lx' *)
   test (sprintf "%#lx" 42l = "0x2a");
   test (sprintf "%4lx" 42l = "  2a");
   test (sprintf "%*lx" 5 42l = "   2a");
-  test (sprintf "%-0+ #*lx" 5 42l = "0x2a ");
+  (*test (sprintf "%-0+ #*lx" 5 42l = "0x2a ");*)
+    (* >> '-' is incompatible with '0' *)
 
   printf "\nlx negative\n%!";
   test (sprintf "%lx" (-42l) = "ffffffd6");
@@ -350,12 +404,15 @@ try
   test (sprintf "%lX" 42l = "2A");
   test (sprintf "%-4lX" 42l = "2A  ");
   test (sprintf "%04lX" 42l = "002A");
-  test (sprintf "%+lX" 42l = "2A");
-  test (sprintf "% lX" 42l = "2A");
+  (*test (sprintf "%+lX" 42l = "2A");*)
+    (* >> '+' is incompatible with 'lX' *)
+  (*test (sprintf "% lX" 42l = "2A");*)
+    (* >> ' ' is incompatible with 'lX' *)
   test (sprintf "%#lX" 42l = "0X2A");
   test (sprintf "%4lX" 42l = "  2A");
   test (sprintf "%*lX" 5 42l = "   2A");
-  test (sprintf "%-0+ #*lX" 5 42l = "0X2A ");
+  (*test (sprintf "%-0+ #*lX" 5 42l = "0X2A ");*)
+    (* >> '-' is incompatible with '0' *)
 
   printf "\nlx negative\n%!";
   test (sprintf "%lX" (-42l) = "FFFFFFD6");
@@ -364,12 +421,15 @@ try
   test (sprintf "%lo" 42l = "52");
   test (sprintf "%-4lo" 42l = "52  ");
   test (sprintf "%04lo" 42l = "0052");
-  test (sprintf "%+lo" 42l = "52");
-  test (sprintf "% lo" 42l = "52");
+  (*test (sprintf "%+lo" 42l = "52");*)
+    (* >> '+' is incompatible with 'lo' *)
+  (*test (sprintf "% lo" 42l = "52");*)
+    (* >> ' ' is incompatible with 'lo' *)
   test (sprintf "%#lo" 42l = "052");
   test (sprintf "%4lo" 42l = "  52");
   test (sprintf "%*lo" 5 42l = "   52");
-  test (sprintf "%-0+ #*lo" 5 42l = "052  ");
+  (*test (sprintf "%-0+ #*lo" 5 42l = "052  ");*)
+    (* >> '-' is incompatible with '0' *)
 
   printf "\nlo negative\n%!";
   test (sprintf "%lo" (-42l) = "37777777726");
@@ -381,34 +441,46 @@ try
   test (sprintf "%Ld/%Li" 42L 43L = "42/43");
   test (sprintf "%-4Ld/%-5Li" 42L 43L = "42  /43   ");
   test (sprintf "%04Ld/%05Li" 42L 43L = "0042/00043");
-  test (sprintf "%+Ld/%+Li" 42L 43L = "+42/+43");
-  test (sprintf "% Ld/% Li" 42L 43L = " 42/ 43");
-  test (sprintf "%#Ld/%#Li" 42L 43L = "42/43");
+  (*test (sprintf "%+Ld/%+Li" 42L 43L = "+42/+43");*)
+    (* >> '+' is incompatible with 'Ld' *)
+  (*test (sprintf "% Ld/% Li" 42L 43L = " 42/ 43");*)
+    (* >> ' ' is incompatible with 'Ld' *)
+  (*test (sprintf "%#Ld/%#Li" 42L 43L = "42/43");*)
+    (* >> '#' is incompatible with 'Ld' *)
   test (sprintf "%4Ld/%5Li" 42L 43L = "  42/   43");
   test (sprintf "%*Ld/%*Li" 4 42L 5 43L = "  42/   43");
-  test (sprintf "%-0+#4Ld/%-0 #5Li" 42L 43L = "+42 / 43  ");
+  (*test (sprintf "%-0+#4Ld/%-0 #5Li" 42L 43L = "+42 / 43  ");*)
+    (* >> '-' is incompatible with '0' *)
 
   printf "\nLd/Li negative\n%!";
   test (sprintf "%Ld/%Li" (-42L) (-43L) = "-42/-43");
   test (sprintf "%-4Ld/%-5Li" (-42L) (-43L) = "-42 /-43  ");
   test (sprintf "%04Ld/%05Li" (-42L) (-43L) = "-042/-0043");
-  test (sprintf "%+Ld/%+Li" (-42L) (-43L) = "-42/-43");
-  test (sprintf "% Ld/% Li" (-42L) (-43L) = "-42/-43");
-  test (sprintf "%#Ld/%#Li" (-42L) (-43L) = "-42/-43");
+  (*test (sprintf "%+Ld/%+Li" (-42L) (-43L) = "-42/-43");*)
+    (* >> '+' is incompatible with 'Ld' *)
+  (*test (sprintf "% Ld/% Li" (-42L) (-43L) = "-42/-43");*)
+    (* >> ' ' is incompatible with 'Ld' *)
+  (*test (sprintf "%#Ld/%#Li" (-42L) (-43L) = "-42/-43");*)
+    (* >> '#' is incompatible with 'Ld' *)
   test (sprintf "%4Ld/%5Li" (-42L) (-43L) = " -42/  -43");
   test (sprintf "%*Ld/%*Li" 4 (-42L) 5 (-43L) = " -42/  -43");
-  test (sprintf "%-0+ #4Ld/%-0+ #5Li" (-42L) (-43L) = "-42 /-43  ");
+  (*test (sprintf "%-0+ #4Ld/%-0+ #5Li" (-42L) (-43L) = "-42 /-43  ");*)
+    (* >> '-' is incompatible with '0' *)
 
   printf "\nLu positive\n%!";
   test (sprintf "%Lu" 42L = "42");
   test (sprintf "%-4Lu" 42L = "42  ");
   test (sprintf "%04Lu" 42L = "0042");
-  test (sprintf "%+Lu" 42L = "42");
-  test (sprintf "% Lu" 42L = "42");
-  test (sprintf "%#Lu" 42L = "42");
+  (*test (sprintf "%+Lu" 42L = "42");*)
+    (* >> '+' is incompatible with 'Lu' *)
+  (*test (sprintf "% Lu" 42L = "42");*)
+    (* >> ' ' is incompatible with 'Lu' *)
+  (*test (sprintf "%#Lu" 42L = "42");*)
+    (* >> '#' is incompatible with 'Lu' *)
   test (sprintf "%4Lu" 42L = "  42");
   test (sprintf "%*Lu" 4 42L = "  42");
-  test (sprintf "%-0+ #6Ld" 42L = "+42   ");
+  (*test (sprintf "%-0+ #6Ld" 42L = "+42   ");*)
+    (* >> '-' is incompatible with '0' *)
 
   printf "\nLu negative\n%!";
   test (sprintf "%Lu" (-1L) = "18446744073709551615");
@@ -417,12 +489,15 @@ try
   test (sprintf "%Lx" 42L = "2a");
   test (sprintf "%-4Lx" 42L = "2a  ");
   test (sprintf "%04Lx" 42L = "002a");
-  test (sprintf "%+Lx" 42L = "2a");
-  test (sprintf "% Lx" 42L = "2a");
+  (*test (sprintf "%+Lx" 42L = "2a");*)
+    (* >> '+' is incompatible with 'Lx' *)
+  (*test (sprintf "% Lx" 42L = "2a");*)
+    (* >> ' ' is incompatible with 'Lx' *)
   test (sprintf "%#Lx" 42L = "0x2a");
   test (sprintf "%4Lx" 42L = "  2a");
   test (sprintf "%*Lx" 5 42L = "   2a");
-  test (sprintf "%-0+ #*Lx" 5 42L = "0x2a ");
+  (*test (sprintf "%-0+ #*Lx" 5 42L = "0x2a ");*)
+    (* >> '-' is incompatible with '0' *)
 
   printf "\nLx negative\n%!";
   test (sprintf "%Lx" (-42L) = "ffffffffffffffd6");
@@ -431,12 +506,15 @@ try
   test (sprintf "%LX" 42L = "2A");
   test (sprintf "%-4LX" 42L = "2A  ");
   test (sprintf "%04LX" 42L = "002A");
-  test (sprintf "%+LX" 42L = "2A");
-  test (sprintf "% LX" 42L = "2A");
+  (*test (sprintf "%+LX" 42L = "2A");*)
+    (* >> '+' is incompatible with 'LX' *)
+  (*test (sprintf "% LX" 42L = "2A");*)
+    (* >> ' ' is incompatible with 'LX' *)
   test (sprintf "%#LX" 42L = "0X2A");
   test (sprintf "%4LX" 42L = "  2A");
   test (sprintf "%*LX" 5 42L = "   2A");
-  test (sprintf "%-0+ #*LX" 5 42L = "0X2A ");
+  (*test (sprintf "%-0+ #*LX" 5 42L = "0X2A ");*)
+    (* >> '-' is incompatible with '0' *)
 
   printf "\nLx negative\n%!";
   test (sprintf "%LX" (-42L) = "FFFFFFFFFFFFFFD6");
@@ -445,12 +523,15 @@ try
   test (sprintf "%Lo" 42L = "52");
   test (sprintf "%-4Lo" 42L = "52  ");
   test (sprintf "%04Lo" 42L = "0052");
-  test (sprintf "%+Lo" 42L = "52");
-  test (sprintf "% Lo" 42L = "52");
+  (*test (sprintf "%+Lo" 42L = "52");*)
+    (* >> '+' is incompatible with 'Lo' *)
+  (*test (sprintf "% Lo" 42L = "52");*)
+    (* >> ' ' is incompatible with 'Lo' *)
   test (sprintf "%#Lo" 42L = "052");
   test (sprintf "%4Lo" 42L = "  52");
   test (sprintf "%*Lo" 5 42L = "   52");
-  test (sprintf "%-0+ #*Lo" 5 42L = "052  ");
+  (*test (sprintf "%-0+ #*Lo" 5 42L = "052  ");*)
+    (* >> '-' is incompatible with '0' *)
 
   printf "\nLo negative\n%!";
   test (sprintf "%Lo" (-42L) = "1777777777777777777726");
@@ -471,7 +552,7 @@ try
 
   printf "\n{...%%}\n%!";
   let f = format_of_string "%4g/%s" in
-  test (sprintf "%{%#0F%S%}" f = "%f%s");
+  test (sprintf "%{%.4F%5S%}" f = "%f%s");
 
   printf "\n(...%%)\n%!";
   let f = format_of_string "%d/foo/%s" in
diff --git a/testsuite/tests/lib-printf/tprintf.reference b/testsuite/tests/lib-printf/tprintf.reference
index 387dfb8533..11ee3a74fd 100644
--- a/testsuite/tests/lib-printf/tprintf.reference
+++ b/testsuite/tests/lib-printf/tprintf.reference
@@ -1,91 +1,91 @@
 d/i positive
- 0 1 2 3 4 5 6 7 8
+ 0 1 2 3 4 5 6
 d/i negative
- 9 10 11 12 13 14 15 16 17
+ 7 8 9 10 11 12 13
 u positive
- 18 19 20 21 22 23 24 25 26
+ 14 15 16 17 18
 u negative
- 27
+ 19
 x positive
- 28 29 30 31 32 33 34 35 36
+ 20 21 22 23 24 25
 x negative
- 37
+ 26
 X positive
- 38 39 40 41 42 43 44 45 46
+ 27 28 29 30 31 32
 x negative
- 47
+ 33
 o positive
- 48 49 50 51 52 53 54 55 56
+ 34 35 36 37 38 39
 o negative
- 57
+ 40
 s
- 58 59 60 61 62 63 64 65 66 67 68 69 70 71
+ 41 42 43 44 45 46 47 48 49
 S
- 72 73 74 75 76 77 78 79 80
+ 50 51 52 53 54 55
 c
- 81 82 83 84
+ 56
 C
- 85 86 87 88 89
+ 57 58
 f
- 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107
+ 59 60 61 62 63 64 65 66 67 68 69 70 71 72
 F
- 108 109 110 111
+ 73 74 75 76
 e
- 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129
+ 77 78 79 80 81 82 83 84 85 86 87 88 89 90
 E
- 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147
+ 91 92 93 94 95 96 97 98 99 100 101 102 103 104
 B
- 148 149
+ 105 106
 ld/li positive
- 150 151 152 153 154 155 156 157 158
+ 107 108 109 110 111 112 113
 ld/li negative
- 159 160 161 162 163 164 165 166 167
+ 114 115 116 117 118 119 120
 lu positive
- 168 169 170 171 172 173 174 175 176
+ 121 122 123 124 125
 lu negative
- 177
+ 126
 lx positive
- 178 179 180 181 182 183 184 185 186
+ 127 128 129 130 131 132
 lx negative
- 187
+ 133
 lX positive
- 188 189 190 191 192 193 194 195 196
+ 134 135 136 137 138 139
 lx negative
- 197
+ 140
 lo positive
- 198 199 200 201 202 203 204 205 206
+ 141 142 143 144 145 146
 lo negative
- 207
+ 147
 Ld/Li positive
- 208 209 210 211 212 213 214 215 216
+ 148 149 150 151 152
 Ld/Li negative
- 217 218 219 220 221 222 223 224 225
+ 153 154 155 156 157
 Lu positive
- 226 227 228 229 230 231 232 233 234
+ 158 159 160 161 162
 Lu negative
- 235
+ 163
 Lx positive
- 236 237 238 239 240 241 242 243 244
+ 164 165 166 167 168 169
 Lx negative
- 245
+ 170
 LX positive
- 246 247 248 249 250 251 252 253 254
+ 171 172 173 174 175 176
 Lx negative
- 255
+ 177
 Lo positive
- 256 257 258 259 260 261 262 263 264
+ 178 179 180 181 182 183
 Lo negative
- 265
+ 184
 a
- 266
+ 185
 t
- 267
+ 186
 {...%}
- 268
+ 187
 (...%)
- 269
+ 188
 ! % @ , and constants
- 270 271 272 273 274 275 276
+ 189 190 191 192 193 194 195
 end of tests
 
 All tests succeeded.
diff --git a/testsuite/tests/lib-scanf/tscanf.ml b/testsuite/tests/lib-scanf/tscanf.ml
index 53c92ffc8d..8e6a252b86 100644
--- a/testsuite/tests/lib-scanf/tscanf.ml
+++ b/testsuite/tests/lib-scanf/tscanf.ml
@@ -1090,13 +1090,13 @@ let test46, test47 =
      Printf.sprintf "%i %(%s%)."
        1 "spells one, %s" "in english"),
   (fun () ->
-     Printf.sprintf "%i ,%{%s%}, %s."
+     Printf.sprintf "%i %{%s%}, %s."
        1 "spells one %s" "in english")
 ;;
 
 test (test46 () = "1 spells one, in english.")
 ;;
-test (test47 () = "1 ,%s, in english.")
+test (test47 () = "1 %s, in english.")
 ;;
 
 (* Testing scanning of meta formats. *)
diff --git a/testsuite/tests/match-exception-warnings/Makefile b/testsuite/tests/match-exception-warnings/Makefile
new file mode 100644
index 0000000000..c9433b2ecb
--- /dev/null
+++ b/testsuite/tests/match-exception-warnings/Makefile
@@ -0,0 +1,15 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 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.                #
+#                                                                       #
+#########################################################################
+
+BASEDIR=../..
+include $(BASEDIR)/makefiles/Makefile.toplevel
+include $(BASEDIR)/makefiles/Makefile.common
diff --git a/testsuite/tests/match-exception-warnings/exhaustiveness_warnings.ml b/testsuite/tests/match-exception-warnings/exhaustiveness_warnings.ml
new file mode 100644
index 0000000000..742038db49
--- /dev/null
+++ b/testsuite/tests/match-exception-warnings/exhaustiveness_warnings.ml
@@ -0,0 +1,12 @@
+(** Test exhaustiveness.
+
+    match clauses should continue to give warnings about inexhaustive
+    value-matching clauses when there is an exception-matching clause
+ *)
+
+let test_match_exhaustiveness () =
+    match None with
+    | exception e -> ()
+    | Some false -> ()
+    | None -> ()
+;;
diff --git a/testsuite/tests/match-exception-warnings/exhaustiveness_warnings.ml.reference b/testsuite/tests/match-exception-warnings/exhaustiveness_warnings.ml.reference
new file mode 100644
index 0000000000..f1e30bc56c
--- /dev/null
+++ b/testsuite/tests/match-exception-warnings/exhaustiveness_warnings.ml.reference
@@ -0,0 +1,11 @@
+
+# * * * *               Characters 210-289:
+  ....match None with
+      | exception e -> ()
+      | Some false -> ()
+      | None -> ()
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a value that is not matched:
+Some true
+val test_match_exhaustiveness : unit -> unit = <fun>
+# 
diff --git a/testsuite/tests/match-exception/Makefile b/testsuite/tests/match-exception/Makefile
new file mode 100644
index 0000000000..299656b246
--- /dev/null
+++ b/testsuite/tests/match-exception/Makefile
@@ -0,0 +1,15 @@
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#                 Xavier Clerc, SED, INRIA Rocquencourt                 #
+#                                                                       #
+#   Copyright 2010 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.                #
+#                                                                       #
+#########################################################################
+
+BASEDIR=../..
+include $(BASEDIR)/makefiles/Makefile.several
+include $(BASEDIR)/makefiles/Makefile.common
diff --git a/testsuite/tests/match-exception/allocation.ml b/testsuite/tests/match-exception/allocation.ml
new file mode 100644
index 0000000000..fa943ffa3f
--- /dev/null
+++ b/testsuite/tests/match-exception/allocation.ml
@@ -0,0 +1,24 @@
+(** Test that matching multiple values doesn't allocate a block. *)
+
+let f x y =
+  match x, y with
+  | Some x, None
+  | None, Some x -> x + 1
+  | None, None -> 0
+  | Some x, Some y -> x + y
+  | exception _ -> -1
+
+let test_multiple_match_does_not_allocate =
+  let allocated_bytes = Gc.allocated_bytes () in
+  let allocated_bytes' = Gc.allocated_bytes () in
+  let a = Some 3 and b = None in
+  let allocated_bytes'' = Gc.allocated_bytes () in
+  let _ = f a b in
+  let allocated_bytes''' = Gc.allocated_bytes () in
+  if allocated_bytes' -. allocated_bytes = allocated_bytes''' -. allocated_bytes''
+  then
+    Printf.printf "no allocations for multiple-value match\n"
+  else
+    Printf.printf "multiple-value match allocated %f bytes\n"
+      ((allocated_bytes''' -. allocated_bytes'') -.
+       (allocated_bytes' -. allocated_bytes))
diff --git a/testsuite/tests/match-exception/allocation.reference b/testsuite/tests/match-exception/allocation.reference
new file mode 100644
index 0000000000..98056ce6e8
--- /dev/null
+++ b/testsuite/tests/match-exception/allocation.reference
@@ -0,0 +1 @@
+no allocations for multiple-value match
diff --git a/testsuite/tests/match-exception/exception_propagation.ml b/testsuite/tests/match-exception/exception_propagation.ml
new file mode 100644
index 0000000000..38d2cfd689
--- /dev/null
+++ b/testsuite/tests/match-exception/exception_propagation.ml
@@ -0,0 +1,17 @@
+(**
+   Test that match allows exceptions to propagate.
+*)
+let () =
+  try
+    match 
+      (let _ = raise Not_found in
+       assert false)
+    with
+    | _ -> assert false
+    | exception Invalid_argument _ -> assert false
+  with
+    Not_found ->
+      print_endline "caught expected exception (Not_found)"
+  | _ ->
+    assert false
+;;
diff --git a/testsuite/tests/match-exception/exception_propagation.reference b/testsuite/tests/match-exception/exception_propagation.reference
new file mode 100644
index 0000000000..a119b6813e
--- /dev/null
+++ b/testsuite/tests/match-exception/exception_propagation.reference
@@ -0,0 +1 @@
+caught expected exception (Not_found)
diff --git a/testsuite/tests/match-exception/match_failure.ml b/testsuite/tests/match-exception/match_failure.ml
new file mode 100644
index 0000000000..c6149bf3bd
--- /dev/null
+++ b/testsuite/tests/match-exception/match_failure.ml
@@ -0,0 +1,19 @@
+(**
+   Test that value match failure in a match block raises Match_failure.
+*)
+let return_some_3 () = Some (1 + 2)
+;;
+
+let test_match_partial_match =
+  try 
+    let _ = (match return_some_3 () with 
+    | Some x when x < 3 -> "Some x"
+    | exception Failure _ -> "failure"
+    | exception Invalid_argument _ -> "invalid argument"
+    | None -> "None"
+    ) in
+    assert false
+  with
+    Match_failure _ ->
+      print_endline "match failure, as expected"
+;;
diff --git a/testsuite/tests/match-exception/match_failure.reference b/testsuite/tests/match-exception/match_failure.reference
new file mode 100644
index 0000000000..6e17840fe3
--- /dev/null
+++ b/testsuite/tests/match-exception/match_failure.reference
@@ -0,0 +1 @@
+match failure, as expected
diff --git a/testsuite/tests/match-exception/nested_handlers.ml b/testsuite/tests/match-exception/nested_handlers.ml
new file mode 100644
index 0000000000..0314cb103b
--- /dev/null
+++ b/testsuite/tests/match-exception/nested_handlers.ml
@@ -0,0 +1,45 @@
+(*
+  Test that multiple handlers coexist happily.
+*)
+
+let test_multiple_handlers =
+  let trace = ref [] in
+  let collect v = trace := v :: !trace in
+  let _ =
+    match
+      begin 
+        match 
+          begin
+            collect "one";
+            failwith "two"
+          end
+        with
+          () -> collect "failure one"
+        | exception (Failure x) ->
+          collect x;
+          failwith "three" 
+      end
+    with
+      () -> 
+        collect "failure two";
+    | exception (Failure x) ->
+      collect x;
+      match 
+        begin
+          collect "four";
+          failwith "five"
+        end
+      with
+        () -> collect "failure three"
+      | exception (Failure x) ->
+        collect x
+  in
+  print_endline (String.concat " " !trace);
+  assert (!trace = [
+    "five";
+    "four";
+    "three";
+    "two";
+    "one";
+  ])
+;;
diff --git a/testsuite/tests/match-exception/nested_handlers.reference b/testsuite/tests/match-exception/nested_handlers.reference
new file mode 100644
index 0000000000..e305286698
--- /dev/null
+++ b/testsuite/tests/match-exception/nested_handlers.reference
@@ -0,0 +1 @@
+five four three two one
diff --git a/testsuite/tests/match-exception/raise_from_success_continuation.ml b/testsuite/tests/match-exception/raise_from_success_continuation.ml
new file mode 100644
index 0000000000..34fb647143
--- /dev/null
+++ b/testsuite/tests/match-exception/raise_from_success_continuation.ml
@@ -0,0 +1,15 @@
+(**
+  Test raising exceptions from a value-matching branch.
+*)
+let test_raise_from_val_handler =
+  let () = print_endline "test raise from val handler" in
+  let g () = List.find ((=)2) [1;2;4] in
+  let h () =
+    match
+      g ()
+    with exception _ -> 10
+    | _ -> raise Not_found
+  in
+  assert ((try h () with Not_found -> 20) = 20);
+  print_endline "raise from val handler succeeded"
+;;
diff --git a/testsuite/tests/match-exception/raise_from_success_continuation.reference b/testsuite/tests/match-exception/raise_from_success_continuation.reference
new file mode 100644
index 0000000000..4cfe216083
--- /dev/null
+++ b/testsuite/tests/match-exception/raise_from_success_continuation.reference
@@ -0,0 +1,2 @@
+test raise from val handler
+raise from val handler succeeded
diff --git a/testsuite/tests/match-exception/streams.ml b/testsuite/tests/match-exception/streams.ml
new file mode 100644
index 0000000000..42e9a5f1da
--- /dev/null
+++ b/testsuite/tests/match-exception/streams.ml
@@ -0,0 +1,37 @@
+(**
+   Test the stream example .
+*)
+type stream = Stream of (int * stream Lazy.t)
+;;
+
+exception End_of_stream
+;;
+
+let make_stream_up_to n =
+  let rec loop i =
+    if i = n then Stream (i, lazy (raise End_of_stream))
+    else Stream (i, lazy (loop (i + 1)))
+  in loop 0
+;;
+
+let stream_get (Stream (x, s)) = (x, Lazy.force s)
+;;
+
+let rec iter_stream_match f s = 
+  match stream_get s
+  with exception End_of_stream -> ()
+  | (x, s') ->
+    begin
+      f x;
+      iter_stream_match f s'
+    end
+;;
+      
+let test_iter_stream =
+  let limit = 10000000 in
+  try
+    iter_stream_match ignore (make_stream_up_to limit);
+    print_endline "iter_stream with handler case (match) is tail recursive"
+  with Stack_overflow ->
+    assert false
+;;
diff --git a/testsuite/tests/match-exception/streams.reference b/testsuite/tests/match-exception/streams.reference
new file mode 100644
index 0000000000..13df46408a
--- /dev/null
+++ b/testsuite/tests/match-exception/streams.reference
@@ -0,0 +1 @@
+iter_stream with handler case (match) is tail recursive
diff --git a/testsuite/tests/match-exception/tail_calls.ml b/testsuite/tests/match-exception/tail_calls.ml
new file mode 100644
index 0000000000..61cf026648
--- /dev/null
+++ b/testsuite/tests/match-exception/tail_calls.ml
@@ -0,0 +1,21 @@
+(**
+    The success continuation expression is in tail position.
+*)
+
+let count_to_tr_match n =
+  let rec loop i =
+    match
+      i < n
+    with exception Not_found -> ()
+    | false -> ()
+    | true -> loop (i + 1)
+  in loop 0
+;;
+
+let test_tail_recursion =
+  try
+    count_to_tr_match 10000000;
+    print_endline "handler-case (match) is tail recursive"
+  with _ ->
+    assert false
+;;
diff --git a/testsuite/tests/match-exception/tail_calls.reference b/testsuite/tests/match-exception/tail_calls.reference
new file mode 100644
index 0000000000..342bf24a29
--- /dev/null
+++ b/testsuite/tests/match-exception/tail_calls.reference
@@ -0,0 +1 @@
+handler-case (match) is tail recursive
diff --git a/testsuite/tests/regression/pr5757/pr5757.ml b/testsuite/tests/regression/pr5757/pr5757.ml
index 5395840c3b..3a40bb51f9 100644
--- a/testsuite/tests/regression/pr5757/pr5757.ml
+++ b/testsuite/tests/regression/pr5757/pr5757.ml
@@ -12,6 +12,6 @@
 
 Random.init 3;;
 for i = 0 to 100_000 do
-  ignore (String.create (Random.int 1_000_000))
+  ignore (Bytes.create (Random.int 1_000_000))
 done;;
 Printf.printf "hello world\n";;
diff --git a/testsuite/tests/regression/pr6024/Makefile b/testsuite/tests/regression/pr6024/Makefile
index 964eefcedb..3426801f57 100644
--- a/testsuite/tests/regression/pr6024/Makefile
+++ b/testsuite/tests/regression/pr6024/Makefile
@@ -12,5 +12,6 @@
 
 MAIN_MODULE=pr6024
 
-include ../../../makefiles/Makefile.one
-include ../../../makefiles/Makefile.common
+BASEDIR=../../..
+include $(BASEDIR)/makefiles/Makefile.one
+include $(BASEDIR)/makefiles/Makefile.common
diff --git a/testsuite/tests/tool-ocamldoc/odoc_test.ml b/testsuite/tests/tool-ocamldoc/odoc_test.ml
index 918cadc40f..9e34bb2a1c 100644
--- a/testsuite/tests/tool-ocamldoc/odoc_test.ml
+++ b/testsuite/tests/tool-ocamldoc/odoc_test.ml
@@ -53,7 +53,19 @@ class string_gen =
              p fmt "# manifest (Odoc_info.string_of_type_expr):\n<[%s]>\n"
                (match t.ty_manifest with
                  None -> "None"
-               | Some e -> Odoc_info.string_of_type_expr e
+               | Some (Other e) -> Odoc_info.string_of_type_expr e
+               | Some (Object_type fields) ->
+                 let b = Buffer.create 256 in
+                 Buffer.add_string b "<";
+                 List.iter
+                   (fun fd ->
+                     Printf.bprintf b " %s: %s ;"
+                       fd.of_name
+                       (Odoc_info.string_of_type_expr fd.of_type)
+                   )
+                   fields;
+                 Buffer.add_string b " >";
+                 Buffer.contents b
                );
             );
 
diff --git a/testsuite/tests/tool-ocamldoc/t01.ml b/testsuite/tests/tool-ocamldoc/t01.ml
index d253be43db..ee291b900b 100644
--- a/testsuite/tests/tool-ocamldoc/t01.ml
+++ b/testsuite/tests/tool-ocamldoc/t01.ml
@@ -16,4 +16,7 @@ module type MT = sig
     (string * string * string) ->
       (string * string * string) -> unit
   val y : int
+
+  type obj_type =
+     < foo : int ; bar : float -> string ; gee : int -> (int * string) >
 end
diff --git a/testsuite/tests/tool-ocamldoc/t01.reference b/testsuite/tests/tool-ocamldoc/t01.reference
index 72345ffecd..d5159bdfc9 100644
--- a/testsuite/tests/tool-ocamldoc/t01.reference
+++ b/testsuite/tests/tool-ocamldoc/t01.reference
@@ -23,6 +23,8 @@
       string * string * string ->
       string * string * string -> string * string * string -> unit
   val y : int
+  type obj_type =
+      < bar : float -> string; foo : int; gee : int -> int * string >
 end]>
 # type T01.MT.t:
 # manifest (Odoc_info.string_of_type_expr):
@@ -31,3 +33,6 @@ end]>
   string ->
   string * string * string ->
   string * string * string -> string * string * string -> unit]>
+# type T01.MT.obj_type:
+# manifest (Odoc_info.string_of_type_expr):
+<[< bar: float -> string ; foo: int ; gee: int -> int * string ; >]>
diff --git a/testsuite/tests/typing-extensions/Makefile b/testsuite/tests/typing-extensions/Makefile
new file mode 100644
index 0000000000..5f42b70577
--- /dev/null
+++ b/testsuite/tests/typing-extensions/Makefile
@@ -0,0 +1,4 @@
+BASEDIR=../..
+include $(BASEDIR)/makefiles/Makefile.toplevel
+include $(BASEDIR)/makefiles/Makefile.common
+
diff --git a/testsuite/tests/typing-extensions/cast.ml b/testsuite/tests/typing-extensions/cast.ml
new file mode 100644
index 0000000000..afcc2080dc
--- /dev/null
+++ b/testsuite/tests/typing-extensions/cast.ml
@@ -0,0 +1,96 @@
+
+(* By using two types we can have a recursive constraint *)
+type 'a class_name = .. constraint 'a = < cast: 'a. 'a name -> 'a; ..>
+and 'a name = Class : 'a class_name -> (< cast: 'a. 'a name -> 'a; ..> as 'a) name
+;;
+
+exception Bad_cast
+;;
+
+class type castable =
+object
+  method cast: 'a.'a name -> 'a
+end
+;;
+
+(* Lets create a castable class with a name*)
+
+class type foo_t =
+object
+  inherit castable
+  method foo: string
+end
+;;
+
+type 'a class_name += Foo: foo_t class_name
+;;
+
+class foo: foo_t =
+object(self)
+  method cast: type a. a name -> a =
+    function
+	Class Foo -> (self :> foo_t)
+      | _ -> ((raise Bad_cast) : a)
+  method foo = "foo"
+end
+;;
+
+(* Now we can create a subclass of foo *)
+
+class type bar_t =
+object
+  inherit foo
+  method bar: string
+end
+;;
+
+type 'a class_name += Bar: bar_t class_name
+;;
+
+class bar: bar_t =
+object(self)
+  inherit foo as super
+  method cast: type a. a name -> a =
+    function
+        Class Bar -> (self :> bar_t)
+      | other -> super#cast other
+  method bar = "bar"
+end
+;;
+
+(* Now lets create a mutable list of castable objects *)
+
+let clist :castable list ref = ref []
+;;
+
+let push_castable (c: #castable) =
+  clist := (c :> castable) :: !clist
+;;
+
+let pop_castable () =
+  match !clist with
+      c :: rest ->
+        clist := rest;
+        c
+    | [] -> raise Not_found
+;;
+
+(* We can add foos and bars to this list, and retrive them *)
+
+push_castable (new foo);;
+push_castable (new bar);;
+push_castable (new foo);;
+
+let c1: castable = pop_castable ();;
+let c2: castable = pop_castable ();;
+let c3: castable = pop_castable ();;
+
+(* We can also downcast these values to foos and bars *)
+
+let f1: foo = c1#cast (Class Foo);; (* Ok *)
+let f2: foo = c2#cast (Class Foo);; (* Ok *)
+let f3: foo = c3#cast (Class Foo);; (* Ok *)
+
+let b1: bar = c1#cast (Class Bar);; (* Exception Bad_cast *)
+let b2: bar = c2#cast (Class Bar);; (* Ok *)
+let b3: bar = c3#cast (Class Bar);; (* Exception Bad_cast *)
diff --git a/testsuite/tests/typing-extensions/cast.ml.reference b/testsuite/tests/typing-extensions/cast.ml.reference
new file mode 100644
index 0000000000..c229741638
--- /dev/null
+++ b/testsuite/tests/typing-extensions/cast.ml.reference
@@ -0,0 +1,33 @@
+
+#         type 'b class_name = .. constraint 'b = < cast : 'a. 'a name -> 'a; .. >
+and 'a name =
+    Class : 'a class_name -> (< cast : 'a0. 'a0 name -> 'a0; .. > as 'a) name
+#     exception Bad_cast
+#           class type castable = object method cast : 'a name -> 'a end
+#                 class type foo_t = object method cast : 'a name -> 'a method foo : string end
+#     type 'b class_name += Foo : foo_t class_name
+#                   class foo : foo_t
+#                 class type bar_t =
+  object
+    method bar : string
+    method cast : 'a name -> 'a
+    method foo : string
+  end
+#     type 'b class_name += Bar : bar_t class_name
+#                     class bar : bar_t
+#         val clist : castable list ref = {contents = []}
+#       val push_castable : #castable -> unit = <fun>
+#               val pop_castable : unit -> castable = <fun>
+#       - : unit = ()
+# - : unit = ()
+# - : unit = ()
+#   val c1 : castable = <obj>
+# val c2 : castable = <obj>
+# val c3 : castable = <obj>
+#       val f1 : foo = <obj>
+# val f2 : foo = <obj>
+# val f3 : foo = <obj>
+#   Exception: Bad_cast.
+# val b2 : bar = <obj>
+# Exception: Bad_cast.
+# 
diff --git a/testsuite/tests/typing-extensions/extensions.ml b/testsuite/tests/typing-extensions/extensions.ml
new file mode 100644
index 0000000000..59a23db9d0
--- /dev/null
+++ b/testsuite/tests/typing-extensions/extensions.ml
@@ -0,0 +1,321 @@
+
+type foo = ..
+;;
+
+type foo +=
+    A
+  | B of int
+;;
+
+let is_a x =
+  match x with
+    A -> true
+  | _ -> false
+;;
+
+(* The type must be open to create extension *)
+
+type foo
+;;
+
+type foo += A of int (* Error type is not open *)
+;;
+
+(* The type parameters must match *)
+
+type 'a foo = ..
+;;
+
+type ('a, 'b) foo += A of int (* Error: type parameter mismatch *)
+;;
+
+(* In a signature the type does not have to be open *)
+
+module type S =
+sig
+  type foo
+  type foo += A of float
+end
+;;
+
+(* But it must still be extensible *)
+
+module type S =
+sig
+  type foo = A of int
+  type foo += B of float (* Error foo does not have an extensible type *)
+end
+;;
+
+(* Signatures can change the grouping of extensions *)
+
+type foo = ..
+;;
+
+module M = struct
+  type foo +=
+      A of int
+    | B of string
+
+  type foo +=
+      C of int
+    | D of float
+end
+;;
+
+module type S = sig
+  type foo +=
+      B of string
+    | C of int
+
+  type foo += D of float
+
+  type foo += A of int
+end
+;;
+
+module M_S = (M : S)
+;;
+
+(* Extensions can be GADTs *)
+
+type 'a foo = ..
+;;
+
+type _ foo +=
+    A : int -> int foo
+  | B : int foo
+;;
+
+let get_num : type a. a foo -> a -> a option = fun f i1 ->
+    match f with
+        A i2 -> Some (i1 + i2)
+     |  _ -> None
+;;
+
+(* Extensions must obey constraints *)
+
+type 'a foo = .. constraint 'a = [> `Var ]
+;;
+
+type 'a foo += A of 'a
+;;
+
+let a = A 9 (* ERROR: Constraints not met *)
+;;
+
+type 'a foo += B : int foo (* ERROR: Constraints not met *)
+;;
+
+(* Signatures can make an extension private *)
+
+type foo = ..
+;;
+
+module M = struct type foo += A of int end
+;;
+
+let a1 = M.A 10
+;;
+
+module type S = sig type foo += private A of int end
+;;
+
+module M_S = (M : S)
+;;
+
+let is_s x =
+  match x with
+    M_S.A _ -> true
+  | _ -> false
+;;
+
+let a2 = M_S.A 20 (* ERROR: Cannot create a value using a private constructor *)
+;;
+
+(* Extensions can be rebound *)
+
+type foo = ..
+;;
+
+module M = struct type foo += A1 of int end
+;;
+
+type foo += A2 = M.A1
+;;
+
+type bar = ..
+;;
+
+type bar += A3 = M.A1    (* Error: rebind wrong type *)
+;;
+
+module M = struct type foo += private B1 of int end
+;;
+
+type foo += private B2 = M.B1
+;;
+
+type foo += B3 = M.B1  (* Error: rebind private extension *)
+;;
+
+type foo += C = Unknown  (* Error: unbound extension *)
+;;
+
+(* Extensions can be rebound even if type is closed *)
+
+module M : sig type foo type foo += A1 of int end
+  = struct type foo = .. type foo += A1 of int end
+
+type M.foo += A2 = M.A1
+
+(* Rebinding handles abbreviations *)
+
+type 'a foo = ..
+;;
+
+type 'a foo1 = 'a foo = ..
+;;
+
+type 'a foo2 = 'a foo = ..
+;;
+
+type 'a foo1 +=
+    A of int
+  | B of 'a
+  | C : int foo1
+;;
+
+type 'a foo2 +=
+    D = A
+  | E = B
+  | F = C
+;;
+
+(* Extensions must obey variances *)
+
+type +'a foo = ..
+;;
+
+type 'a foo += A of (int -> 'a)
+;;
+
+type 'a foo += B of ('a -> int) (* ERROR: Parameter variances are not satisfied *)
+;;
+
+type _ foo += C : ('a -> int) -> 'a foo (* ERROR: Parameter variances are not satisfied *)
+;;
+
+type 'a bar = ..
+;;
+
+type +'a bar += D of (int -> 'a) (* ERROR: type variances do not match *)
+;;
+
+(* Exceptions are compatible with extensions *)
+
+module M : sig
+  type exn +=
+      Foo of int * float
+    | Bar : 'a list -> exn
+end = struct
+  exception Bar : 'a list -> exn
+  exception Foo of int * float
+end
+;;
+
+module M : sig
+  exception Bar : 'a list -> exn
+  exception Foo of int * float
+end = struct
+  type exn +=
+      Foo of int * float
+    | Bar : 'a list -> exn
+end
+;;
+
+exception Foo of int * float
+;;
+
+exception Bar : 'a list -> exn
+;;
+
+module M : sig
+  type exn +=
+      Foo of int * float
+    | Bar : 'a list -> exn
+end = struct
+  exception Bar = Bar
+  exception Foo = Foo
+end
+;;
+
+(* Test toplevel printing *)
+
+type foo = ..
+;;
+
+type foo +=
+    Foo of int * int option
+  | Bar of int option
+;;
+
+let x = Foo(3, Some 4), Bar(Some 5) (* Prints Foo and Bar successfully *)
+;;
+
+type foo += Foo of string
+;;
+
+let y = x (* Prints Bar but not Foo (which has been shadowed) *)
+;;
+
+exception Foo of int * int option
+;;
+
+exception Bar of int option
+;;
+
+let x = Foo(3, Some 4), Bar(Some 5) (* Prints Foo and Bar successfully *)
+;;
+
+type foo += Foo of string
+;;
+
+let y = x (* Prints Bar and part of Foo (which has been shadowed) *)
+;;
+
+(* Test Obj functions *)
+
+type foo = ..
+;;
+
+type foo +=
+    Foo
+  | Bar of int
+;;
+
+let n1 = Obj.extension_name Foo
+;;
+
+let n2 = Obj.extension_name (Bar 1)
+;;
+
+let t = (Obj.extension_id (Bar 2)) = (Obj.extension_id (Bar 3)) (* true *)
+;;
+
+let f = (Obj.extension_id (Bar 2)) = (Obj.extension_id Foo) (* false *)
+;;
+
+let is_foo x = (Obj.extension_id Foo) = (Obj.extension_id x)
+
+type foo += Foo
+;;
+
+let f = is_foo Foo
+;;
+
+let _ = Obj.extension_name 7 (* Invald_arg *)
+;;
+
+let _ = Obj.extension_id (object method m = 3 end) (* Invald_arg *)
+;;
diff --git a/testsuite/tests/typing-extensions/extensions.ml.reference b/testsuite/tests/typing-extensions/extensions.ml.reference
new file mode 100644
index 0000000000..25af292de1
--- /dev/null
+++ b/testsuite/tests/typing-extensions/extensions.ml.reference
@@ -0,0 +1,131 @@
+
+#     type foo = ..
+#         type foo += A | B of int
+#           val is_a : foo -> bool = <fun>
+#         type foo
+#     Characters 13-21:
+  type foo += A of int (* Error type is not open *)
+              ^^^^^^^^
+Error: Cannot extend type definition foo
+#         type 'a foo = ..
+#     Characters 1-30:
+  type ('a, 'b) foo += A of int (* Error: type parameter mismatch *)
+  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This extension does not match the definition of type foo
+       They have different arities.
+#                 module type S = sig type foo type foo += A of float end
+#                 Characters 84-106:
+    type foo += B of float (* Error foo does not have an extensible type *)
+    ^^^^^^^^^^^^^^^^^^^^^^
+Error: Type foo is not extensible
+#         type foo = ..
+#                     module M :
+  sig
+    type foo += A of int | B of string
+    type foo += C of int | D of float
+    
+  end
+#                     module type S =
+  sig
+    type foo += B of string | C of int
+    type foo += D of float
+    type foo += A of int
+  end
+#     module M_S : S
+#         type 'a foo = ..
+#         type _ foo += A : int -> int foo | B : int foo
+#           val get_num : 'a foo -> 'a -> 'a option = <fun>
+#         type 'a foo = .. constraint 'a = [> `Var ]
+#     type 'a foo += A of 'a
+#     Characters 11-12:
+  let a = A 9 (* ERROR: Constraints not met *)
+            ^
+Error: This expression has type int but an expression was expected of type
+         [> `Var ]
+#     Characters 20-23:
+  type 'a foo += B : int foo (* ERROR: Constraints not met *)
+                     ^^^
+Error: This type int should be an instance of type [> `Var ]
+#         type foo = ..
+#     module M : sig type foo += A of int end
+#     val a1 : foo = M.A 10
+#     module type S = sig type foo += private A of int end
+#     module M_S : S
+#           val is_s : foo -> bool = <fun>
+#     Characters 10-18:
+  let a2 = M_S.A 20 (* ERROR: Cannot create a value using a private constructor *)
+           ^^^^^^^^
+Error: Cannot create values of the private type foo
+#         type foo = ..
+#     module M : sig type foo += A1 of int end
+#     type foo += A2 of int
+#     type bar = ..
+#     Characters 18-22:
+  type bar += A3 = M.A1    (* Error: rebind wrong type *)
+                   ^^^^
+Error: The constructor M.A1 has type foo but was expected to be of type bar
+#     module M : sig type foo += private B1 of int end
+#     type foo += private B2 of int
+#     Characters 18-22:
+  type foo += B3 = M.B1  (* Error: rebind private extension *)
+                   ^^^^
+Error: The constructor M.B1 is private
+#     Characters 13-24:
+  type foo += C = Unknown  (* Error: unbound extension *)
+              ^^^^^^^^^^^
+Error: Unbound constructor Unknown
+#                       module M : sig type foo type foo += A1 of int end
+type M.foo += A2 of int
+type 'a foo = ..
+#     type 'a foo1 = 'a foo = ..
+#     type 'a foo2 = 'a foo = ..
+#           type 'a foo1 += A of int | B of 'a | C : int foo1
+#           type 'a foo2 += D of int | E of 'a | F : int foo2
+#         type +'a foo = ..
+#     type 'a foo += A of (int -> 'a)
+#     Characters 1-32:
+  type 'a foo += B of ('a -> int) (* ERROR: Parameter variances are not satisfied *)
+  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: In this definition, expected parameter variances are not satisfied.
+       The 1st type parameter was expected to be covariant,
+       but it is injective contravariant.
+#     Characters 1-40:
+  type _ foo += C : ('a -> int) -> 'a foo (* ERROR: Parameter variances are not satisfied *)
+  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: In this definition, expected parameter variances are not satisfied.
+       The 1st type parameter was expected to be covariant,
+       but it is injective contravariant.
+#     type 'a bar = ..
+#     Characters 1-33:
+  type +'a bar += D of (int -> 'a) (* ERROR: type variances do not match *)
+  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This extension does not match the definition of type bar
+       Their variances do not agree.
+#                       module M : sig type exn += Foo of int * float | Bar : 'a list -> exn  end
+#                   module M :
+  sig exception Bar : 'a list -> exn exception Foo of int * float end
+#     exception Foo of int * float
+#     exception Bar : 'a list -> exn
+#                   module M : sig type exn += Foo of int * float | Bar : 'a list -> exn  end
+#         type foo = ..
+#         type foo += Foo of int * int option | Bar of int option
+#     val x : foo * foo = (Foo (3, Some 4), Bar (Some 5))
+#     type foo += Foo of string
+#     val y : foo * foo = (<extension>, Bar (Some 5))
+#     exception Foo of int * int option
+#     exception Bar of int option
+#     val x : exn * exn = (Foo (3, Some 4), Bar (Some 5))
+#     type foo += Foo of string
+#     val y : exn * exn = (Foo (3, _), Bar (Some 5))
+#         type foo = ..
+#         type foo += Foo | Bar of int
+#     val n1 : string = "Foo"
+#     val n2 : string = "Bar"
+#     val t : bool = true
+#     val f : bool = false
+#         val is_foo : 'a -> bool = <fun>
+type foo += Foo
+#     val f : bool = false
+#     Exception: Invalid_argument "Obj.extension_name".
+#     Exception: Invalid_argument "Obj.extension_id".
+# 
diff --git a/testsuite/tests/typing-extensions/msg.ml b/testsuite/tests/typing-extensions/msg.ml
new file mode 100644
index 0000000000..ef1c12fb4c
--- /dev/null
+++ b/testsuite/tests/typing-extensions/msg.ml
@@ -0,0 +1,131 @@
+(* Typed names *)
+
+module Msg : sig
+
+  type 'a tag
+
+  type result = Result : 'a tag * 'a -> result
+
+  val write : 'a tag -> 'a -> unit
+
+  val read : unit -> result
+
+  type 'a tag += Int : int tag
+
+  module type Desc = sig
+    type t
+    val label : string
+    val write : t -> string
+    val read : string -> t
+  end
+
+  module Define (D : Desc) : sig
+    type 'a tag += C : D.t tag
+  end
+
+end = struct
+
+  type 'a tag = ..
+
+  type ktag = T : 'a tag -> ktag
+
+  type 'a kind =
+  { tag : 'a tag;
+    label : string;
+    write : 'a -> string;
+    read : string -> 'a; }
+
+  type rkind = K : 'a kind -> rkind
+
+  type wkind = { f : 'a . 'a tag -> 'a kind }
+
+  let readTbl : (string, rkind) Hashtbl.t = Hashtbl.create 13
+
+  let writeTbl : (ktag, wkind) Hashtbl.t = Hashtbl.create 13
+
+  let read_raw () : string * string = raise (Failure "Not implemented")
+
+  type result = Result : 'a tag * 'a -> result
+
+  let read () =
+    let label, content = read_raw () in
+      let K k = Hashtbl.find readTbl label in
+        let body = k.read content in
+          Result(k.tag, body)
+
+  let write_raw (label : string) (content : string) =
+    raise (Failure "Not implemented")
+
+  let write (tag : 'a tag) (body : 'a) =
+    let {f} = Hashtbl.find writeTbl (T tag) in
+    let k = f tag in
+    let content = k.write body in
+      write_raw k.label content
+
+  (* Add int kind *)
+
+  type 'a tag += Int : int tag
+
+  let ik =
+    { tag = Int;
+      label = "int";
+      write = string_of_int;
+      read = int_of_string }
+
+  let () = Hashtbl.add readTbl "int" (K ik)
+
+  let () =
+    let f (type t) (i : t tag) : t kind =
+      match i with
+        Int -> ik
+      | _ -> assert false
+    in
+      Hashtbl.add writeTbl (T Int) {f}
+
+  (* Support user defined kinds *)
+
+  module type Desc = sig
+    type t
+    val label : string
+    val write : t -> string
+    val read : string -> t
+  end
+
+  module Define (D : Desc) = struct
+    type 'a tag += C : D.t tag
+    let k =
+      { tag = C;
+        label = D.label;
+        write = D.write;
+        read = D.read }
+    let () = Hashtbl.add readTbl D.label (K k)
+    let () =
+      let f (type t) (c : t tag) : t kind =
+        match c with
+          C -> k
+        | _ -> assert false
+      in
+        Hashtbl.add writeTbl (T C) {f}
+  end
+
+end;;
+
+let write_int i = Msg.write Msg.Int i;;
+
+module StrM = Msg.Define(struct
+  type t = string
+  let label = "string"
+  let read s = s
+  let write s = s
+end);;
+
+type 'a Msg.tag += String = StrM.C;;
+
+let write_string s = Msg.write String s;;
+
+let read_one () =
+  let Msg.Result(tag, body) = Msg.read () in
+  match tag with
+    Msg.Int -> print_int body
+  | String -> print_string body
+  | _ -> print_string "Unknown";;
diff --git a/testsuite/tests/typing-extensions/msg.ml.reference b/testsuite/tests/typing-extensions/msg.ml.reference
new file mode 100644
index 0000000000..e7f1a8f248
--- /dev/null
+++ b/testsuite/tests/typing-extensions/msg.ml.reference
@@ -0,0 +1,23 @@
+
+#                                                                                                                                                                                                                             module Msg :
+  sig
+    type 'a tag
+    type result = Result : 'a tag * 'a -> result
+    val write : 'a tag -> 'a -> unit
+    val read : unit -> result
+    type 'a tag += Int : int tag
+    module type Desc =
+      sig
+        type t
+        val label : string
+        val write : t -> string
+        val read : string -> t
+      end
+    module Define : functor (D : Desc) -> sig type 'a tag += C : D.t tag end
+  end
+#   val write_int : int -> unit = <fun>
+#             module StrM : sig type 'a Msg.tag += C : string Msg.tag end
+#   type 'a Msg.tag += String : string Msg.tag
+#   val write_string : string -> unit = <fun>
+#             val read_one : unit -> unit = <fun>
+# 
diff --git a/testsuite/tests/typing-extensions/open_types.ml b/testsuite/tests/typing-extensions/open_types.ml
new file mode 100644
index 0000000000..e7632cac29
--- /dev/null
+++ b/testsuite/tests/typing-extensions/open_types.ml
@@ -0,0 +1,109 @@
+type foo = ..
+;;
+
+(* Check that abbreviations work *)
+
+type bar = foo = ..
+;;
+
+type baz = foo = ..
+;;
+
+type bar += Bar1 of int
+;;
+
+type baz += Bar2 of int
+;;
+
+module M = struct type bar += Foo of float end
+;;
+
+module type S = sig type baz += Foo of float end
+;;
+
+module M_S = (M : S)
+;;
+
+(* Abbreviations need to be made open *)
+
+type foo = ..
+;;
+
+type bar = foo
+;;
+
+type bar += Bar of int (* Error: type is not open *)
+;;
+
+type baz = bar = .. (* Error: type kinds don't match *)
+;;
+
+(* Abbreviations need to match parameters *)
+
+type 'a foo = ..
+;;
+
+type ('a, 'b) bar = 'a foo = .. (* Error: arrities do not match *)
+;;
+
+type ('a, 'b) foo = ..
+;;
+
+type ('a, 'b) bar = ('a, 'a) foo = .. (* Error: constraints do not match *)
+;;
+
+(* Private abstract types cannot be open *)
+
+type foo = ..
+;;
+
+type bar = private foo = .. (* ERROR: Private abstract types cannot be open *)
+;;
+
+(* Check that signatures can hide open-ness *)
+
+module M = struct type foo = .. end
+;;
+
+module type S = sig type foo end
+;;
+
+module M_S = (M : S)
+;;
+
+type M_S.foo += Foo (* ERROR: Cannot extend a type that isn't "open" *)
+;;
+
+(* Check that signatures cannot add open-ness *)
+
+module M = struct type foo end
+;;
+
+module type S = sig type foo = .. end
+;;
+
+module M_S = (M : S) (* ERROR: Signatures are not compatible *)
+;;
+
+(* Check that signatures maintain variances *)
+
+module M = struct type +'a foo = .. type 'a bar = 'a foo = .. end
+;;
+
+module type S = sig type 'a foo = .. type 'a bar = 'a foo = .. end
+;;
+
+module M_S = (M : S) (* ERROR: Signatures are not compatible *)
+;;
+
+(* Exn is an open type *)
+
+type exn2 = exn = ..
+;;
+
+(* Exhaustiveness *)
+
+type foo = ..
+type foo += Foo
+let f = function Foo -> ()
+;; (* warn *)
diff --git a/testsuite/tests/typing-extensions/open_types.ml.reference b/testsuite/tests/typing-extensions/open_types.ml.reference
new file mode 100644
index 0000000000..5fb9684d47
--- /dev/null
+++ b/testsuite/tests/typing-extensions/open_types.ml.reference
@@ -0,0 +1,83 @@
+
+#   type foo = ..
+#         type bar = foo = ..
+#     type baz = foo = ..
+#     type bar += Bar1 of int
+#     type baz += Bar2 of int
+#     module M : sig type bar += Foo of float end
+#     module type S = sig type baz += Foo of float end
+#     module M_S : S
+#         type foo = ..
+#     type bar = foo
+#     Characters 13-23:
+  type bar += Bar of int (* Error: type is not open *)
+              ^^^^^^^^^^
+Error: Cannot extend type definition bar
+#     Characters 6-20:
+  type baz = bar = .. (* Error: type kinds don't match *)
+       ^^^^^^^^^^^^^^
+Error: This variant or record definition does not match that of type bar
+       Their kinds differ.
+#         type 'a foo = ..
+#     Characters 6-32:
+  type ('a, 'b) bar = 'a foo = .. (* Error: arrities do not match *)
+       ^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This variant or record definition does not match that of type 'a foo
+       They have different arities.
+#     type ('a, 'b) foo = ..
+#     Characters 6-38:
+  type ('a, 'b) bar = ('a, 'a) foo = .. (* Error: constraints do not match *)
+       ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This variant or record definition does not match that of type
+         ('a, 'a) foo
+       Their constraints differ.
+#         type foo = ..
+#     Characters 24-25:
+  type bar = private foo = .. (* ERROR: Private abstract types cannot be open *)
+                         ^
+Error: Syntax error
+#         module M : sig type foo = .. end
+#     module type S = sig type foo end
+#     module M_S : S
+#     Characters 17-20:
+  type M_S.foo += Foo (* ERROR: Cannot extend a type that isn't "open" *)
+                  ^^^
+Error: Cannot extend type definition M_S.foo
+#         module M : sig type foo end
+#     module type S = sig type foo = .. end
+#     Characters 15-16:
+  module M_S = (M : S) (* ERROR: Signatures are not compatible *)
+                ^
+Error: Signature mismatch:
+       Modules do not match: sig type foo = M.foo end is not included in S
+       Type declarations do not match:
+         type foo = M.foo
+       is not included in
+         type foo = ..
+       Their kinds differ.
+#         module M : sig type +'a foo = .. type 'a bar = 'a foo = .. end
+#     module type S = sig type 'a foo = .. type 'a bar = 'a foo = .. end
+#     Characters 15-16:
+  module M_S = (M : S) (* ERROR: Signatures are not compatible *)
+                ^
+Error: Signature mismatch:
+       Modules do not match:
+         sig type 'a foo = 'a M.foo = .. type 'a bar = 'a foo = .. end
+       is not included in
+         S
+       Type declarations do not match:
+         type 'a foo = 'a M.foo = ..
+       is not included in
+         type 'a foo = ..
+       Their variances do not agree.
+#         type exn2 = exn = ..
+#             Characters 61-79:
+  let f = function Foo -> ()
+          ^^^^^^^^^^^^^^^^^^
+Warning 8: this pattern-matching is not exhaustive.
+Here is an example of a value that is not matched:
+*extension*
+type foo = ..
+type foo += Foo
+val f : foo -> unit = <fun>
+# 
diff --git a/testsuite/tests/typing-gadts/pr6174.ml.principal.reference b/testsuite/tests/typing-gadts/pr6174.ml.principal.reference
index 647015c367..8f2be5252c 100644
--- a/testsuite/tests/typing-gadts/pr6174.ml.principal.reference
+++ b/testsuite/tests/typing-gadts/pr6174.ml.principal.reference
@@ -1,8 +1,7 @@
 
-#     Characters 118-119:
+#     Characters 137-138:
    fun C k -> k (fun x -> x);;
-       ^
-Error: Recursive local constraint when unifying
-         (((ex#0 -> ex#1) -> ex#1) -> (ex#2 -> ex#1) -> ex#1) t
-       with ((a -> o) -> o) t
+                          ^
+Error: This expression has type ex#0 but an expression was expected of type
+         ex#1 = (ex#2 -> ex#1) -> ex#1
 # 
diff --git a/testsuite/tests/typing-gadts/pr6174.ml.reference b/testsuite/tests/typing-gadts/pr6174.ml.reference
index 647015c367..8f2be5252c 100644
--- a/testsuite/tests/typing-gadts/pr6174.ml.reference
+++ b/testsuite/tests/typing-gadts/pr6174.ml.reference
@@ -1,8 +1,7 @@
 
-#     Characters 118-119:
+#     Characters 137-138:
    fun C k -> k (fun x -> x);;
-       ^
-Error: Recursive local constraint when unifying
-         (((ex#0 -> ex#1) -> ex#1) -> (ex#2 -> ex#1) -> ex#1) t
-       with ((a -> o) -> o) t
+                          ^
+Error: This expression has type ex#0 but an expression was expected of type
+         ex#1 = (ex#2 -> ex#1) -> ex#1
 # 
diff --git a/testsuite/tests/typing-gadts/test.ml b/testsuite/tests/typing-gadts/test.ml
index a8215290ad..2f0bb91962 100644
--- a/testsuite/tests/typing-gadts/test.ml
+++ b/testsuite/tests/typing-gadts/test.ml
@@ -102,12 +102,8 @@ module Existential_escape =
 module Rectype =
   struct
     type (_,_) t = C : ('a,'a) t
-    let _ =
-      fun (type s) ->
-        let a : (s, s * s) t = failwith "foo" in
-        match a with
-          C ->
-            ()
+    let f : type s. (s, s*s) t -> unit =
+      fun C -> () (* here s = s*s! *)
   end
 ;;
 
diff --git a/testsuite/tests/typing-gadts/test.ml.principal.reference b/testsuite/tests/typing-gadts/test.ml.principal.reference
index 0d40f674a5..fd9fb3501c 100644
--- a/testsuite/tests/typing-gadts/test.ml.principal.reference
+++ b/testsuite/tests/typing-gadts/test.ml.principal.reference
@@ -53,10 +53,8 @@ module Nonexhaustive :
 Error: This expression has type a#2 t but an expression was expected of type
          a#2 t
        The type constructor a#2 would escape its scope
-#                       Characters 174-175:
-            C ->
-            ^
-Error: Recursive local constraint when unifying (s, s) t with (s, s * s) t
+#               module Rectype :
+  sig type (_, _) t = C : ('a, 'a) t val f : ('s, 's * 's) t -> unit end
 #                         Characters 178-186:
           | (IntLit _ | BoolLit _) -> ()
              ^^^^^^^^
diff --git a/testsuite/tests/typing-gadts/test.ml.reference b/testsuite/tests/typing-gadts/test.ml.reference
index e6aa47b415..a5faa02c01 100644
--- a/testsuite/tests/typing-gadts/test.ml.reference
+++ b/testsuite/tests/typing-gadts/test.ml.reference
@@ -53,10 +53,8 @@ module Nonexhaustive :
 Error: This expression has type a#2 t but an expression was expected of type
          a#2 t
        The type constructor a#2 would escape its scope
-#                       Characters 174-175:
-            C ->
-            ^
-Error: Recursive local constraint when unifying (s, s) t with (s, s * s) t
+#               module Rectype :
+  sig type (_, _) t = C : ('a, 'a) t val f : ('s, 's * 's) t -> unit end
 #                         Characters 178-186:
           | (IntLit _ | BoolLit _) -> ()
              ^^^^^^^^
diff --git a/testsuite/tests/typing-modules/Test.ml b/testsuite/tests/typing-modules/Test.ml
index e5cbe9f395..97ef3f1687 100644
--- a/testsuite/tests/typing-modules/Test.ml
+++ b/testsuite/tests/typing-modules/Test.ml
@@ -54,3 +54,8 @@ module type B = A with type t = u;; (* fail *)
 (* PR#5815 *)
 
 module type S = sig exception Foo of int  exception Foo of bool end;;
+
+(* PR#6410 *)
+
+module F(X : sig end) = struct let x = 3 end;;
+F.x;; (* fail *)
diff --git a/testsuite/tests/typing-modules/Test.ml.principal.reference b/testsuite/tests/typing-modules/Test.ml.principal.reference
index 8e993fa3aa..d99e9a3cd3 100644
--- a/testsuite/tests/typing-modules/Test.ml.principal.reference
+++ b/testsuite/tests/typing-modules/Test.ml.principal.reference
@@ -29,4 +29,9 @@ Error: Signature mismatch:
 Error: This variant or record definition does not match that of type u
        The types for field X are not equal.
 #       module type S = sig exception Foo of bool end
+#       module F : functor (X : sig  end) -> sig val x : int end
+# Characters 0-3:
+  F.x;; (* fail *)
+  ^^^
+Error: The module F is a functor, not a structure
 # 
diff --git a/testsuite/tests/typing-modules/Test.ml.reference b/testsuite/tests/typing-modules/Test.ml.reference
index 8e993fa3aa..d99e9a3cd3 100644
--- a/testsuite/tests/typing-modules/Test.ml.reference
+++ b/testsuite/tests/typing-modules/Test.ml.reference
@@ -29,4 +29,9 @@ Error: Signature mismatch:
 Error: This variant or record definition does not match that of type u
        The types for field X are not equal.
 #       module type S = sig exception Foo of bool end
+#       module F : functor (X : sig  end) -> sig val x : int end
+# Characters 0-3:
+  F.x;; (* fail *)
+  ^^^
+Error: The module F is a functor, not a structure
 # 
diff --git a/testsuite/tests/typing-modules/aliases.ml b/testsuite/tests/typing-modules/aliases.ml
index a65812e4bb..b77b0c47db 100644
--- a/testsuite/tests/typing-modules/aliases.ml
+++ b/testsuite/tests/typing-modules/aliases.ml
@@ -204,3 +204,19 @@ module type Alias = sig module N : sig end module M = N end;;
 module F (X : sig end) = struct type t end;;
 module type A = Alias with module N := F(List);;
 module rec Bad : A = Bad;;
+
+(* Shinwell 2014-04-23 *)
+module B = struct
+ module R = struct
+   type t = string
+ end
+
+ module O = R
+end
+
+module K = struct
+ module E = B
+ module N = E.O
+end;;
+
+let x : K.N.t = "foo";;
diff --git a/testsuite/tests/typing-modules/aliases.ml.reference b/testsuite/tests/typing-modules/aliases.ml.reference
index d31516b987..e820b78e28 100644
--- a/testsuite/tests/typing-modules/aliases.ml.reference
+++ b/testsuite/tests/typing-modules/aliases.ml.reference
@@ -371,4 +371,7 @@ Error: Module type declarations do not match:
   module rec Bad : A = Bad;;
                    ^
 Error: Unbound module type A
+#                           module B : sig module R : sig type t = string end module O = R end
+module K : sig module E = B module N = E.O end
+#   val x : K.N.t = "foo"
 # 
diff --git a/testsuite/tests/typing-objects/Tests.ml.principal.reference b/testsuite/tests/typing-objects/Tests.ml.principal.reference
index 76ade67556..4821b58781 100644
--- a/testsuite/tests/typing-objects/Tests.ml.principal.reference
+++ b/testsuite/tests/typing-objects/Tests.ml.principal.reference
@@ -244,9 +244,9 @@ Error: Signature mismatch:
          val f : (#c as 'a) -> 'a
        is not included in
          val f : #c -> #c
-#   Characters 32-55:
+#   Characters 38-39:
   module M = struct type t = int class t () = object end end;;
-                                 ^^^^^^^^^^^^^^^^^^^^^^^
+                                       ^
 Error: Multiple definition of the type name t.
        Names must be unique in a given structure or signature.
 #   - : < m : (< m : 'a > as 'b) -> 'b as 'a; .. > -> 'b = <fun>
@@ -295,12 +295,12 @@ Warning 10: this expression should have type unit.
   unit -> object method private m : int method n : int method o : int end
 #   - : int * int = (1, 1)
 #   class c : unit -> object method m : int end
-#       - : int = 95
-# - : int = 96
-# - : int = 97
-#         - : int * int * int = (98, 99, 100)
-#           - : int * int * int * int * int = (101, 102, 103, 33, 33)
-#           - : int * int * int * int * int = (104, 105, 106, 33, 33)
+#       - : int = 100
+# - : int = 101
+# - : int = 102
+#         - : int * int * int = (103, 104, 105)
+#           - : int * int * int * int * int = (106, 107, 108, 33, 33)
+#           - : int * int * int * int * int = (109, 110, 111, 33, 33)
 #         Characters 42-69:
   class a = let _ = new b in object end
             ^^^^^^^^^^^^^^^^^^^^^^^^^^^
diff --git a/testsuite/tests/typing-objects/Tests.ml.reference b/testsuite/tests/typing-objects/Tests.ml.reference
index 97ed42ca7d..25ab6d86c6 100644
--- a/testsuite/tests/typing-objects/Tests.ml.reference
+++ b/testsuite/tests/typing-objects/Tests.ml.reference
@@ -244,9 +244,9 @@ Error: Signature mismatch:
          val f : (#c as 'a) -> 'a
        is not included in
          val f : #c -> #c
-#   Characters 32-55:
+#   Characters 38-39:
   module M = struct type t = int class t () = object end end;;
-                                 ^^^^^^^^^^^^^^^^^^^^^^^
+                                       ^
 Error: Multiple definition of the type name t.
        Names must be unique in a given structure or signature.
 #   - : < m : (< m : 'a > as 'b) -> 'b as 'a; .. > -> 'b = <fun>
@@ -294,12 +294,12 @@ Warning 10: this expression should have type unit.
   unit -> object method private m : int method n : int method o : int end
 #   - : int * int = (1, 1)
 #   class c : unit -> object method m : int end
-#       - : int = 95
-# - : int = 96
-# - : int = 97
-#         - : int * int * int = (98, 99, 100)
-#           - : int * int * int * int * int = (101, 102, 103, 33, 33)
-#           - : int * int * int * int * int = (104, 105, 106, 33, 33)
+#       - : int = 100
+# - : int = 101
+# - : int = 102
+#         - : int * int * int = (103, 104, 105)
+#           - : int * int * int * int * int = (106, 107, 108, 33, 33)
+#           - : int * int * int * int * int = (109, 110, 111, 33, 33)
 #         Characters 42-69:
   class a = let _ = new b in object end
             ^^^^^^^^^^^^^^^^^^^^^^^^^^^
diff --git a/testsuite/tests/typing-objects/pr6383.ml b/testsuite/tests/typing-objects/pr6383.ml
new file mode 100644
index 0000000000..bd2fdb06f0
--- /dev/null
+++ b/testsuite/tests/typing-objects/pr6383.ml
@@ -0,0 +1 @@
+let f (x: #M.foo) = 0;;
diff --git a/testsuite/tests/typing-objects/pr6383.ml.reference b/testsuite/tests/typing-objects/pr6383.ml.reference
new file mode 100644
index 0000000000..01b6141d3f
--- /dev/null
+++ b/testsuite/tests/typing-objects/pr6383.ml.reference
@@ -0,0 +1,6 @@
+
+# Characters 10-16:
+  let f (x: #M.foo) = 0;;
+            ^^^^^^
+Error: Unbound module M
+# 
diff --git a/testsuite/tests/typing-warnings/coercions.ml.principal.reference b/testsuite/tests/typing-warnings/coercions.ml.principal.reference
index d950e231fc..d5397bf05e 100644
--- a/testsuite/tests/typing-warnings/coercions.ml.principal.reference
+++ b/testsuite/tests/typing-warnings/coercions.ml.principal.reference
@@ -7,7 +7,9 @@ Warning 18: this coercion to format6 is not principal.
 # Characters 28-48:
   fun b -> if b then "x" else format_of_string "y";;
                               ^^^^^^^^^^^^^^^^^^^^
-Error: This expression has type ('a, 'b, 'c, 'd, 'd, 'a) format6
+Error: This expression has type
+         ('a, 'b, 'c, 'd, 'd, 'a) format6 =
+           ('a, 'b, 'c, 'd, 'd, 'a) CamlinternalFormatBasics.format6
        but an expression was expected of type string
 # - : bool -> ('a, 'b, 'a) format = <fun>
 # 
diff --git a/testsuite/tests/typing-warnings/coercions.ml.reference b/testsuite/tests/typing-warnings/coercions.ml.reference
index 2ab458b682..f442130510 100644
--- a/testsuite/tests/typing-warnings/coercions.ml.reference
+++ b/testsuite/tests/typing-warnings/coercions.ml.reference
@@ -3,7 +3,9 @@
 # Characters 28-48:
   fun b -> if b then "x" else format_of_string "y";;
                               ^^^^^^^^^^^^^^^^^^^^
-Error: This expression has type ('a, 'b, 'c, 'd, 'd, 'a) format6
+Error: This expression has type
+         ('a, 'b, 'c, 'd, 'd, 'a) format6 =
+           ('a, 'b, 'c, 'd, 'd, 'a) CamlinternalFormatBasics.format6
        but an expression was expected of type string
 # - : bool -> ('a, 'b, 'a) format = <fun>
 # 
diff --git a/testsuite/typing b/testsuite/typing
index ff3818c1ce..cb953d6ac0 100644
--- a/testsuite/typing
+++ b/testsuite/typing
@@ -1,3 +1,4 @@
+tests/typing-extensions
 tests/typing-fstclassmod
 tests/typing-gadts
 tests/typing-implicit_unpack
diff --git a/tools/.depend b/tools/.depend
index a058ee37f3..ea66ede860 100644
--- a/tools/.depend
+++ b/tools/.depend
@@ -28,15 +28,13 @@ depend.cmx : ../parsing/parsetree.cmi ../utils/misc.cmx \
     ../parsing/longident.cmx ../parsing/location.cmx ../parsing/asttypes.cmi \
     depend.cmi
 dumpobj.cmo : ../utils/tbl.cmi opnames.cmo ../bytecomp/opcodes.cmo \
-    ../utils/misc.cmi ../parsing/location.cmi ../bytecomp/lambda.cmi \
-    ../bytecomp/instruct.cmi ../typing/ident.cmi ../utils/config.cmi \
-    ../bytecomp/cmo_format.cmi ../bytecomp/bytesections.cmi \
-    ../parsing/asttypes.cmi
+    ../parsing/location.cmi ../bytecomp/lambda.cmi ../bytecomp/instruct.cmi \
+    ../typing/ident.cmi ../utils/config.cmi ../bytecomp/cmo_format.cmi \
+    ../bytecomp/bytesections.cmi ../parsing/asttypes.cmi
 dumpobj.cmx : ../utils/tbl.cmx opnames.cmx ../bytecomp/opcodes.cmx \
-    ../utils/misc.cmx ../parsing/location.cmx ../bytecomp/lambda.cmx \
-    ../bytecomp/instruct.cmx ../typing/ident.cmx ../utils/config.cmx \
-    ../bytecomp/cmo_format.cmi ../bytecomp/bytesections.cmx \
-    ../parsing/asttypes.cmi
+    ../parsing/location.cmx ../bytecomp/lambda.cmx ../bytecomp/instruct.cmx \
+    ../typing/ident.cmx ../utils/config.cmx ../bytecomp/cmo_format.cmi \
+    ../bytecomp/bytesections.cmx ../parsing/asttypes.cmi
 eqparsetree.cmo : ../parsing/parsetree.cmi ../parsing/longident.cmi \
     ../parsing/location.cmi ../parsing/asttypes.cmi
 eqparsetree.cmx : ../parsing/parsetree.cmi ../parsing/longident.cmx \
diff --git a/tools/Makefile.shared b/tools/Makefile.shared
index 6b33a5b047..251743449f 100644
--- a/tools/Makefile.shared
+++ b/tools/Makefile.shared
@@ -13,12 +13,12 @@
 include ../config/Makefile
 
 CAMLRUN=../boot/ocamlrun
-CAMLC=$(CAMLRUN) ../boot/ocamlc -strict-sequence -nostdlib -I ../boot
+CAMLC=$(CAMLRUN) ../boot/ocamlc -nostdlib -I ../boot
 CAMLOPT=$(CAMLRUN) ../ocamlopt -nostdlib -I ../stdlib
 CAMLLEX=$(CAMLRUN) ../boot/ocamllex
 INCLUDES=-I ../utils -I ../parsing -I ../typing -I ../bytecomp -I ../asmcomp \
 	 -I ../driver -I ../toplevel
-COMPFLAGS= -w +32..39 -warn-error A $(INCLUDES)
+COMPFLAGS= -strict-sequence -w +27+32..39 -warn-error A -safe-string $(INCLUDES)
 LINKFLAGS=$(INCLUDES)
 
 all: ocamldep ocamlprof ocamlcp ocamloptp ocamlmktop ocamlmklib dumpobj \
@@ -39,7 +39,7 @@ CAMLDEP_OBJ=depend.cmo ocamldep.cmo
 CAMLDEP_IMPORTS=misc.cmo config.cmo clflags.cmo terminfo.cmo \
   warnings.cmo location.cmo longident.cmo \
   syntaxerr.cmo ast_helper.cmo parser.cmo lexer.cmo parse.cmo \
-  ccomp.cmo pparse.cmo compenv.cmo
+  ccomp.cmo ast_mapper.cmo pparse.cmo compenv.cmo
 
 ocamldep: depend.cmi $(CAMLDEP_OBJ)
 	$(CAMLC) $(LINKFLAGS) -compat-32 -o ocamldep $(CAMLDEP_IMPORTS) $(CAMLDEP_OBJ)
@@ -264,7 +264,7 @@ opnames.ml: ../byterun/instruct.h
 	sed -e '/\/\*/d' \
 	    -e '/^#/d' \
 	    -e 's/enum \(.*\) {/let names_of_\1 = [|/' \
-	    -e 's/};$$/ |]/' \
+	    -e 's/.*};$$/ |]/' \
 	    -e 's/\([A-Z][A-Z_0-9a-z]*\)/"\1"/g' \
 	    -e 's/,/;/g' \
 	../byterun/instruct.h > opnames.ml
diff --git a/tools/check-typo b/tools/check-typo
index 93814131e5..ea7c63f775 100755
--- a/tools/check-typo
+++ b/tools/check-typo
@@ -23,6 +23,7 @@
 # - absence of empty lines at end of file (white-at-eof)
 # - presence of a LF character at the end of the file (missing-lf)
 # - maximum line length of 80 characters (long-line)
+# - maximum line length of 132 characters (very-long-line)
 # - presence of a copyright header (missing-header)
 # - absence of a leftover "$Id" string (svn-keyword)
 
@@ -49,6 +50,9 @@
 #     *.mltop
 #     *.odocl
 #     *.clib
+# - Any file whose name matches the following pattern is automatically
+#   exempt from the "long-line" rule (but not from "very-long-line").
+#   */ocamldoc/*
 
 # ASCII characters are bytes from 0 to 127.  Any other byte is
 # flagged as a non-ASCII character.
@@ -130,14 +134,15 @@ IGNORE_DIRS="
       svnrules=`svn propget ocaml:typo "$f"`
     fi
     rules="$userrules"
+    add_hd(){ rules="missing-header,$rules"; }
     case "$f" in
       Makefile*|*/Makefile*) rules="tab,$rules";;
+      */.depend*|*/.ignore) add_hd;;
+      *.mlpack|*.mllib|*.mltop|*.odocl|*.itarget|*.clib) add_hd;;
+      *.reference|*/reference) continue;;
     esac
-    h(){ rules="missing-header,$rules"; }
     case "$f" in
-      */.depend*|*/.ignore) h;;
-      *.mlpack|*.mllib|*.mltop|*.odocl|*.itarget|*.clib) h;;
-      *.reference|*/reference) continue;;
+      ocamldoc/*|*/ocamldoc/*) rules="long-line,$rules";;
     esac
 
     (cat "$f"; echo) \
@@ -182,6 +187,12 @@ IGNORE_DIRS="
           err("long-line", "line is over 80 characters");
         }
 
+        length($0) > 132 {
+          RSTART = 133;
+          RLENGTH = 0;
+          err("very-long-line", "line is over 132 characters");
+        }
+
         3 <= NR && NR <= 5 \
         && (/ OCaml / || / ocamlbuild / || / OCamldoc /) {
           header_ocaml = NR;
diff --git a/tools/ci-build b/tools/ci-build
new file mode 100755
index 0000000000..4bb2593eb6
--- /dev/null
+++ b/tools/ci-build
@@ -0,0 +1,159 @@
+#!/bin/sh
+#########################################################################
+#                                                                       #
+#                                 OCaml                                 #
+#                                                                       #
+#          Damien Doligez, projet Gallium, INRIA Rocquencourt           #
+#                                                                       #
+#   Copyright 2014 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.                #
+#                                                                       #
+#########################################################################
+
+# This script is run on our continuous-integration servers to recompile
+# from scratch and run the test suite.
+
+# arguments:
+# 1. architecture: bsd, macos, linux, cygwin, mingw, mingw64, msvc, msvc64
+# 2. directory in which to build (trunk, 4.02, etc)
+#    for windows, this is relative to $HOME/jenkins-workspace
+#    for bsd, macos, linux, this is "." or an absolute directory
+# 3. options:
+#    -conf configure-option
+#    -patch1 file-name       apply patch with -p1
+
+error () {
+  echo "$1" >&2
+  exit 3
+}
+
+#########################################################################
+# be verbose
+set -x
+
+#########################################################################
+# "Parse" mandatory command-line arguments.
+
+arch="$1"
+branch="$2"
+shift 2
+
+#########################################################################
+# If we are called from a Windows batch script, we must set up the
+# Unix environment variables (e.g. PATH).
+
+case "$arch" in
+  bsd|macos|linux) ;;
+  cygwin|mingw|mingw64)
+    . /etc/profile
+    . "$HOME/.profile"
+  ;;
+  msvc)
+    . /etc/profile
+    . "$HOME/.profile"
+    . "$HOME/.msenv32"
+  ;;
+  msvc64)
+    . /etc/profile
+    . "$HOME/.profile"
+    . "$HOME/.msenv64"
+  ;;
+  *) error "unknown architecture: $arch";;
+esac
+
+#########################################################################
+
+# be verbose and stop on error
+set -ex
+
+#########################################################################
+# set up variables
+
+# default values
+make=make
+instdir="$HOME/ocaml-tmp-install"
+workdir="$branch"
+docheckout=false
+nt=
+
+case "$arch" in
+  bsd)
+    make=gmake
+  ;;
+  macos) ;;
+  linux) ;;
+  cygwin)
+    workdir="$HOME/jenkins-workspace/$branch"
+    docheckout=true
+  ;;
+  mingw)
+    instdir=/cygdrive/c/ocamlmgw
+    workdir="$HOME/jenkins-workspace/$branch"
+    docheckout=true
+    nt=.nt
+  ;;
+  mingw64)
+    instdir=/cygdrive/c/ocamlmgw64
+    workdir="$HOME/jenkins-workspace/$branch"
+    docheckout=true
+    nt=.nt
+  ;;
+  msvc)
+    instdir=/cygdrive/c/ocamlms
+    workdir="$HOME/jenkins-workspace/$branch"
+    docheckout=true
+    nt=.nt
+  ;;
+  msvc64)
+    instdir=/cygdrive/c/ocamlms64
+    workdir="$HOME/jenkins-workspace/$branch"
+    docheckout=true
+    nt=.nt
+  ;;
+  *) error "unknown architecture: $arch";;
+esac
+
+#########################################################################
+# Go to the right directory
+
+cd "$workdir"
+
+#########################################################################
+# parse optional command-line arguments (has to be done after the "cd")
+# Configure options are not allowed to have spaces or special characters
+# for the moment. We'll fix that when needed.
+confoptions=""
+while [ $# -gt 0 ]; do
+  case $1 in
+    -conf) confoptions="$confoptions $2"; shift 2;;
+    -patch1) patch -f -p1 <"$2"; shift 2;;
+    *) error "unknown option $1";;
+  esac
+done
+
+#########################################################################
+# Do the work
+
+$make -f Makefile$nt distclean || :
+
+if $docheckout; then
+  svn update --accept theirs-full
+fi
+
+case $nt in
+  "") ./configure -prefix "$instdir" $confoptions;;
+  .nt)
+    cp config/m-nt.h config/m.h
+    cp config/s-nt.h config/s.h
+    cp config/Makefile.$arch config/Makefile
+  ;;
+  *) error "internal error";;
+esac
+
+$make -f Makefile$nt world.opt
+$make -f Makefile$nt install
+
+rm -rf "$instdir"
+cd testsuite
+$make all
diff --git a/tools/cmt2annot.ml b/tools/cmt2annot.ml
index a7c5a005f0..eee0c79065 100644
--- a/tools/cmt2annot.ml
+++ b/tools/cmt2annot.ml
@@ -87,8 +87,10 @@ let iterator rebuild_env =
           bind_bindings exp.exp_loc bindings
       | Texp_let (Nonrecursive, bindings, body) ->
           bind_bindings body.exp_loc bindings
+      | Texp_match (_, f1, f2, _) ->
+        bind_cases f1;
+        bind_cases f2
       | Texp_function (_, f, _)
-      | Texp_match (_, f, _)
       | Texp_try (_, f) ->
           bind_cases f
       | _ -> ()
@@ -154,7 +156,7 @@ let gen_annot target_filename filename
     match target_filename with
     | None -> Some (filename ^ ".annot")
     | Some "-" -> None
-    | Some filename -> target_filename
+    | Some _ -> target_filename
   in
   let iterator = iterator cmt_use_summaries in
   match cmt_annots with
@@ -187,7 +189,7 @@ let gen_ml target_filename filename cmt =
   let target_filename = match target_filename with
       None -> Some (filename ^ ext)
     | Some "-" -> None
-    | Some filename -> target_filename
+    | Some _ -> target_filename
   in
   let oc = match target_filename with
       None -> None
diff --git a/tools/depend.ml b/tools/depend.ml
index 01d3349c30..b6556c5c93 100644
--- a/tools/depend.ml
+++ b/tools/depend.ml
@@ -26,12 +26,12 @@ let rec addmodule bv lid =
     Lident s ->
       if not (StringSet.mem s bv)
       then free_structure_names := StringSet.add s !free_structure_names
-  | Ldot(l, s) -> addmodule bv l
+  | Ldot(l, _s) -> addmodule bv l
   | Lapply(l1, l2) -> addmodule bv l1; addmodule bv l2
 
 let add bv lid =
   match lid.txt with
-    Ldot(l, s) -> addmodule bv l
+    Ldot(l, _s) -> addmodule bv l
   | _ -> ()
 
 let addmodule bv lid = addmodule bv lid.txt
@@ -39,16 +39,16 @@ let addmodule bv lid = addmodule bv lid.txt
 let rec add_type bv ty =
   match ty.ptyp_desc with
     Ptyp_any -> ()
-  | Ptyp_var v -> ()
+  | Ptyp_var _ -> ()
   | Ptyp_arrow(_, t1, t2) -> add_type bv t1; add_type bv t2
   | Ptyp_tuple tl -> List.iter (add_type bv) tl
   | Ptyp_constr(c, tl) -> add bv c; List.iter (add_type bv) tl
-  | Ptyp_object (fl, _) -> List.iter (fun (_, t) -> add_type bv t) fl
+  | Ptyp_object (fl, _) -> List.iter (fun (_, _, t) -> add_type bv t) fl
   | Ptyp_class(c, tl) -> add bv c; List.iter (add_type bv) tl
-  | Ptyp_alias(t, s) -> add_type bv t
+  | Ptyp_alias(t, _) -> add_type bv t
   | Ptyp_variant(fl, _, _) ->
       List.iter
-        (function Rtag(_,_,stl) -> List.iter (add_type bv) stl
+        (function Rtag(_,_,_,stl) -> List.iter (add_type bv) stl
           | Rinherit sty -> add_type bv sty)
         fl
   | Ptyp_poly(_, t) -> add_type bv t
@@ -63,11 +63,12 @@ let add_opt add_fn bv = function
     None -> ()
   | Some x -> add_fn bv x
 
-let add_constructor_decl bv pcd =
-  begin match pcd.pcd_args with
+let add_constructor_arguments bv = function
   | Pcstr_tuple l -> List.iter (add_type bv) l
   | Pcstr_record l -> List.iter (fun l -> add_type bv l.pld_type) l
-  end;
+
+let add_constructor_decl bv pcd =
+  add_constructor_arguments bv pcd.pcd_args;
   Misc.may (add_type bv) pcd.pcd_res
 
 let add_type_declaration bv td =
@@ -80,9 +81,21 @@ let add_type_declaration bv td =
   | Ptype_variant cstrs ->
       List.iter (add_constructor_decl bv) cstrs
   | Ptype_record lbls ->
-      List.iter (fun pld -> add_type bv pld.pld_type) lbls in
+      List.iter (fun pld -> add_type bv pld.pld_type) lbls
+  | Ptype_open -> () in
   add_tkind td.ptype_kind
 
+let add_extension_constructor bv ext =
+  match ext.pext_kind with
+    Pext_decl(args, rty) ->
+      add_constructor_arguments bv args;
+      Misc.may (add_type bv) rty
+  | Pext_rebind lid -> add bv lid
+
+let add_type_extension bv te =
+  add bv te.ptyext_path;
+  List.iter (add_extension_constructor bv) te.ptyext_constructors
+
 let rec add_class_type bv cty =
   match cty.pcty_desc with
     Pcty_constr(l, tyl) ->
@@ -100,6 +113,7 @@ and add_class_type_field bv pctf =
   | Pctf_val(_, _, _, ty) -> add_type bv ty
   | Pctf_method(_, _, _, ty) -> add_type bv ty
   | Pctf_constraint(ty1, ty2) -> add_type bv ty1; add_type bv ty2
+  | Pctf_attribute _ -> ()
   | Pctf_extension _ -> ()
 
 let add_class_description bv infos =
@@ -127,6 +141,7 @@ let rec add_pattern bv pat =
   | Ppat_type li -> add bv li
   | Ppat_lazy p -> add_pattern bv p
   | Ppat_unpack id -> pattern_bv := StringSet.add id.txt !pattern_bv
+  | Ppat_exception p -> add_pattern bv p
   | Ppat_extension _ -> ()
 
 let add_pattern bv pat =
@@ -170,10 +185,10 @@ let rec add_expr bv exp =
   | Pexp_constraint(e1, ty2) ->
       add_expr bv e1;
       add_type bv ty2
-  | Pexp_send(e, m) -> add_expr bv e
+  | Pexp_send(e, _m) -> add_expr bv e
   | Pexp_new li -> add bv li
-  | Pexp_setinstvar(v, e) -> add_expr bv e
-  | Pexp_override sel -> List.iter (fun (s, e) -> add_expr bv e) sel
+  | Pexp_setinstvar(_v, e) -> add_expr bv e
+  | Pexp_override sel -> List.iter (fun (_s, e) -> add_expr bv e) sel
   | Pexp_letmodule(id, m, e) ->
       add_module bv m; add_expr (StringSet.add id.txt bv) e
   | Pexp_assert (e) -> add_expr bv e
@@ -231,8 +246,10 @@ and add_sig_item bv item =
       add_type bv vd.pval_type; bv
   | Psig_type dcls ->
       List.iter (add_type_declaration bv) dcls; bv
-  | Psig_exception pcd ->
-      add_constructor_decl bv pcd; bv
+  | Psig_typext te ->
+      add_type_extension bv te; bv
+  | Psig_exception pext ->
+      add_extension_constructor bv pext; bv
   | Psig_module pmd ->
       add_modtype bv pmd.pmd_type; StringSet.add pmd.pmd_name.txt bv
   | Psig_recmodule decls ->
@@ -288,10 +305,11 @@ and add_struct_item bv item =
       add_type bv vd.pval_type; bv
   | Pstr_type dcls ->
       List.iter (add_type_declaration bv) dcls; bv
-  | Pstr_exception pcd ->
-      add_constructor_decl bv pcd; bv
-  | Pstr_exn_rebind er ->
-      add bv er.pexrb_lid; bv
+  | Pstr_typext te ->
+      add_type_extension bv te;
+      bv
+  | Pstr_exception pext ->
+      add_extension_constructor bv pext; bv
   | Pstr_module x ->
       add_module bv x.pmb_expr; StringSet.add x.pmb_name.txt bv
   | Pstr_recmodule bindings ->
@@ -355,7 +373,7 @@ and add_class_field bv pcf =
   | Pcf_method(_, _, Cfk_virtual ty) -> add_type bv ty
   | Pcf_constraint(ty1, ty2) -> add_type bv ty1; add_type bv ty2
   | Pcf_initializer e -> add_expr bv e
-  | Pcf_extension _ -> ()
+  | Pcf_attribute _ | Pcf_extension _ -> ()
 
 and add_class_declaration bv decl =
   add_class_expr bv decl.pci_expr
diff --git a/tools/dumpobj.ml b/tools/dumpobj.ml
index f1255e9cd2..d95c210da4 100644
--- a/tools/dumpobj.ml
+++ b/tools/dumpobj.ml
@@ -481,8 +481,8 @@ let print_reloc (info, pos) =
 
 (* Print a .cmo file *)
 
-let dump_obj filename ic =
-  let buffer = Misc.input_bytes ic (String.length cmo_magic_number) in
+let dump_obj ic =
+  let buffer = really_input_string ic (String.length cmo_magic_number) in
   if buffer <> cmo_magic_number then begin
     prerr_endline "Not an object file"; exit 2
   end;
@@ -502,7 +502,7 @@ let dump_obj filename ic =
 (* Read the primitive table from an executable *)
 
 let read_primitive_table ic len =
-  let p = Misc.input_bytes ic len in
+  let p = really_input_string ic len in
   let rec split beg cur =
     if cur >= len then []
     else if p.[cur] = '\000' then
@@ -557,7 +557,7 @@ let arg_fun filename =
   begin try
           objfile := false; dump_exe ic
     with Bytesections.Bad_magic_number ->
-      objfile := true; seek_in ic 0; dump_obj filename ic
+      objfile := true; seek_in ic 0; dump_obj ic
   end;
   close_in ic;
   printf "## end of ocaml dump of %S\n%!" filename
diff --git a/tools/make-version-header.sh b/tools/make-version-header.sh
index b5e69be956..26c5c14280 100755
--- a/tools/make-version-header.sh
+++ b/tools/make-version-header.sh
@@ -13,9 +13,6 @@
 #                                                                       #
 #########################################################################
 
-# For maximal compatibility with older versions, we Use "ocamlc -v"
-# instead of "ocamlc -vnum" or the VERSION file in .../lib/ocaml/.
-
 # This script extracts the components from an OCaml version number
 # and provides them as C defines:
 # OCAML_VERSION_MAJOR: the major version number
@@ -26,7 +23,18 @@
 # Note that additional-info is always absent in officially-released
 # versions of OCaml.
 
-version="`ocamlc -v | sed -n -e 's/.*version //p'`"
+# usage:
+# make-version-header.sh [version-file]
+# The argument is the VERSION file from the OCaml sources.
+# If the argument is not given, the version number from "ocamlc -v" will
+# be used.
+
+case $# in
+  0) version="`ocamlc -v | sed -n -e 's/.*version //p'`";;
+  1) version="`sed -e 1q $1`";;
+  *) echo "usage: make-version-header.sh [version-file]" >&2
+     exit 2;;
+esac
 
 major="`echo "$version" | sed -n -e '1s/^\([0-9]*\)\..*/\1/p'`"
 minor="`echo "$version" | sed -n -e '1s/^[0-9]*\.\([0-9]*\).*/\1/p'`"
@@ -34,10 +42,12 @@ patchlvl="`echo "$version" | sed -n -e '1s/^[0-9]*\.[0-9]*\.\([0-9]*\).*/\1/p'`"
 suffix="`echo "$version" | sed -n -e '1s/^[^+]*+\(.*\)/\1/p'`"
 
 echo "#define OCAML_VERSION_MAJOR $major"
-echo "#define OCAML_VERSION_MINOR $minor"
+printf "#define OCAML_VERSION_MINOR %d\n" $minor
 case $patchlvl in "") patchlvl=0;; esac
 echo "#define OCAML_VERSION_PATCHLEVEL $patchlvl"
 case "$suffix" in
   "") echo "#undef OCAML_VERSION_ADDITIONAL";;
   *) echo "#define OCAML_VERSION_ADDITIONAL \"$suffix\"";;
 esac
+printf "#define OCAML_VERSION %d%02d%02d\n" $major $minor $patchlvl
+echo "#define OCAML_VERSION_STRING \"$version\""
diff --git a/tools/objinfo.ml b/tools/objinfo.ml
index 6f3ec75665..37a03b3427 100644
--- a/tools/objinfo.ml
+++ b/tools/objinfo.ml
@@ -31,11 +31,18 @@ let input_stringlist ic len =
       else acc
     in fold 0 0 []
   in
-  let sect = Misc.input_bytes ic len in
+  let sect = really_input_string ic len in
   get_string_list sect len
 
-let print_name_crc (name, crc) =
-  printf "\t%s\t%s\n" (Digest.to_hex crc) name
+let dummy_crc = String.make 32 '-'
+
+let print_name_crc (name, crco) =
+  let crc =
+    match crco with
+      None -> dummy_crc
+    | Some crc -> Digest.to_hex crc
+  in
+    printf "\t%s\t%s\n" crc name
 
 let print_line name =
   printf "\t%s\n" name
@@ -69,11 +76,28 @@ let print_cma_infos (lib : Cmo_format.library) =
   printf "\n";
   List.iter print_cmo_infos lib.lib_units
 
-let print_cmi_infos name sign crcs =
+let print_cmi_infos name crcs =
   printf "Unit name: %s\n" name;
   printf "Interfaces imported:\n";
   List.iter print_name_crc crcs
 
+let print_cmt_infos cmt =
+  let open Cmt_format in
+  printf "Cmt unit name: %s\n" cmt.cmt_modname;
+  print_string "Cmt interfaces imported:\n";
+  List.iter print_name_crc cmt.cmt_imports;
+  printf "Source file: %s\n"
+         (match cmt.cmt_sourcefile with None -> "(none)" | Some f -> f);
+  printf "Compilation flags:";
+  Array.iter print_spaced_string cmt.cmt_args;
+  printf "\nLoad path:";
+  List.iter print_spaced_string cmt.cmt_loadpath;
+  printf "\n";
+  printf "cmt interface digest: %s\n"
+    (match cmt.cmt_interface_digest with
+     | None -> ""
+     | Some crc -> Digest.to_hex crc)
+
 let print_general_infos name crc defines cmi cmx =
   printf "Name: %s\n" name;
   printf "CRC of implementation: %s\n" (Digest.to_hex crc);
@@ -143,7 +167,7 @@ let dump_byte ic =
            | "CRCS" ->
                p_section
                  "Imported units"
-                 (input_value ic : (string * Digest.t) list)
+                 (input_value ic : (string * Digest.t option) list)
            | "DLLS" ->
                p_list
                  "Used DLLs"
@@ -189,7 +213,7 @@ let dump_obj filename =
   printf "File %s\n" filename;
   let ic = open_in_bin filename in
   let len_magic_number = String.length cmo_magic_number in
-  let magic_number = Misc.input_bytes ic len_magic_number in
+  let magic_number = really_input_string ic len_magic_number in
   if magic_number = cmo_magic_number then begin
     let cu_pos = input_binary_int ic in
     seek_in ic cu_pos;
@@ -202,11 +226,19 @@ let dump_obj filename =
     let toc = (input_value ic : library) in
     close_in ic;
     print_cma_infos toc
-  end else if magic_number = cmi_magic_number then begin
-    let cmi = Cmi_format.input_cmi ic in
+  end else if magic_number = cmi_magic_number ||
+              magic_number = cmt_magic_number then begin
     close_in ic;
-    print_cmi_infos cmi.Cmi_format.cmi_name cmi.Cmi_format.cmi_sign
-      cmi.Cmi_format.cmi_crcs
+    let cmi, cmt = Cmt_format.read filename in
+    begin match cmi with
+     | None -> ()
+     | Some cmi ->
+         print_cmi_infos cmi.Cmi_format.cmi_name cmi.Cmi_format.cmi_crcs
+    end;
+    begin match cmt with
+     | None -> ()
+     | Some cmt -> print_cmt_infos cmt
+    end
   end else if magic_number = cmx_magic_number then begin
     let ui = (input_value ic : unit_infos) in
     let crc = Digest.input ic in
@@ -219,7 +251,7 @@ let dump_obj filename =
   end else begin
     let pos_trailer = in_channel_length ic - len_magic_number in
     let _ = seek_in ic pos_trailer in
-    let _ = really_input ic magic_number 0 len_magic_number in
+    let magic_number = really_input_string ic len_magic_number in
     if magic_number = Config.exec_magic_number then begin
       dump_byte ic;
       close_in ic
diff --git a/tools/ocamlcp.ml b/tools/ocamlcp.ml
index bca5ae63c5..75adcb82ef 100644
--- a/tools/ocamlcp.ml
+++ b/tools/ocamlcp.ml
@@ -54,6 +54,7 @@ module Options = Main_args.Make_bytecomp_options (struct
   let _dllib = option_with_arg "-dllib"
   let _dllpath = option_with_arg "-dllpath"
   let _dtypes = option "-dtypes"
+  let _for_pack = option_with_arg "-for-pack"
   let _g = option "-g"
   let _i = option "-i"
   let _I s = option_with_arg "-I" s
@@ -64,25 +65,28 @@ module Options = Main_args.Make_bytecomp_options (struct
   let _labels = option "-labels"
   let _linkall = option "-linkall"
   let _make_runtime = option "-make-runtime"
+  let _no_alias_deps = option "-no-alias-deps"
   let _no_app_funct = option "-no-app-funct"
   let _noassert = option "-noassert"
   let _nolabels = option "-nolabels"
   let _noautolink = option "-noautolink"
   let _nostdlib = option "-nostdlib"
   let _o s = option_with_arg "-o" s
+  let _open s = option_with_arg "-open" s
   let _output_obj = option "-output-obj"
   let _pack = option "-pack"
-  let _pp s = incompatible "-pp"
-  let _ppx s = incompatible "-ppx"
+  let _pp _s = incompatible "-pp"
+  let _ppx _s = incompatible "-ppx"
   let _principal = option "-principal"
   let _rectypes = option "-rectypes"
   let _runtime_variant s = option_with_arg "-runtime-variant" s
+  let _safe_string = option "-safe-string"
   let _short_paths = option "-short-paths"
   let _strict_sequence = option "-strict-sequence"
-  let _trans_mod = option "-trans-mod"
   let _thread () = option "-thread" ()
   let _vmthread () = option "-vmthread" ()
   let _unsafe = option "-unsafe"
+  let _unsafe_string = option "-unsafe-string"
   let _use_prims s = option_with_arg "-use-prims" s
   let _use_runtime s = option_with_arg "-use-runtime" s
   let _v = option "-v"
diff --git a/tools/ocamldep.ml b/tools/ocamldep.ml
index 735a5f97b5..59fecc412c 100644
--- a/tools/ocamldep.ml
+++ b/tools/ocamldep.ml
@@ -18,7 +18,6 @@ let ppf = Format.err_formatter
 
 type file_kind = ML | MLI;;
 
-let include_dirs = ref []
 let load_path = ref ([] : (string * string array) list)
 let ml_synonyms = ref [".ml"]
 let mli_synonyms = ref [".mli"]
@@ -35,11 +34,7 @@ let files = ref []
 
 let fix_slash s =
   if Sys.os_type = "Unix" then s else begin
-    let r = String.copy s in
-    for i = 0 to String.length r - 1 do
-      if r.[i] = '\\' then r.[i] <- '/'
-    done;
-    r
+    String.map (function '\\' -> '/' | c -> c) s
   end
 
 (* Since we reinitialize load_path after reading OCAMLCOMP,
@@ -160,20 +155,20 @@ let print_filename s =
       else count n (i+1)
     in
     let spaces = count 0 0 in
-    let result = String.create (String.length s + spaces) in
+    let result = Bytes.create (String.length s + spaces) in
     let rec loop i j =
       if i >= String.length s then ()
       else if s.[i] = ' ' then begin
-        result.[j] <- '\\';
-        result.[j+1] <- ' ';
+        Bytes.set result j '\\';
+        Bytes.set result (j+1) ' ';
         loop (i+1) (j+2);
       end else begin
-        result.[j] <- s.[i];
+        Bytes.set result j s.[i];
         loop (i+1) (j+1);
       end
     in
     loop 0 0;
-    print_string result;
+    print_bytes result;
   end
 ;;
 
@@ -205,7 +200,7 @@ let print_raw_dependencies source_file deps =
 
 (* Process one file *)
 
-let report_err source_file exn =
+let report_err exn =
   error_occurred := true;
   match exn with
     | Sys_error msg ->
@@ -217,13 +212,15 @@ let report_err source_file exn =
               Location.report_error err
         | None -> raise x
 
+let tool_name = "ocamldep"
+
 let read_parse_and_extract parse_function extract_function magic source_file =
   Depend.free_structure_names := Depend.StringSet.empty;
   try
     let input_file = Pparse.preprocess source_file in
     begin try
       let ast =
-        Pparse.file Format.err_formatter input_file parse_function magic in
+        Pparse.file ~tool_name Format.err_formatter input_file parse_function magic in
       extract_function Depend.StringSet.empty ast;
       Pparse.remove_preprocessed input_file;
       !Depend.free_structure_names
@@ -232,7 +229,7 @@ let read_parse_and_extract parse_function extract_function magic source_file =
       raise x
     end
   with x ->
-    report_err source_file x;
+    report_err x;
     Depend.StringSet.empty
 
 let ml_file_dependencies source_file =
@@ -288,7 +285,7 @@ let mli_file_dependencies source_file =
       print_raw_dependencies source_file extracted_deps
     end else begin
       let basename = Filename.chop_extension source_file in
-      let (byt_deps, opt_deps) =
+      let (byt_deps, _opt_deps) =
         Depend.StringSet.fold (find_dependency MLI)
           extracted_deps ([], []) in
       print_dependencies [basename ^ ".cmi"] byt_deps
@@ -299,7 +296,7 @@ let file_dependencies_as kind source_file =
   load_path := [];
   List.iter add_to_load_path (
       (!Compenv.last_include_dirs @
-       !include_dirs @
+       !Clflags.include_dirs @
        !Compenv.first_include_dirs
       ));
   Location.input_name := source_file;
@@ -309,7 +306,7 @@ let file_dependencies_as kind source_file =
       | ML -> ml_file_dependencies source_file
       | MLI -> mli_file_dependencies source_file
     end
-  with x -> report_err source_file x
+  with x -> report_err x
 
 let file_dependencies source_file =
   if List.exists (Filename.check_suffix source_file) !ml_synonyms then
@@ -324,8 +321,9 @@ let sort_files_by_dependencies files =
 
 (* Init Hashtbl with all defined modules *)
   let files = List.map (fun (file, file_kind, deps) ->
-    let modname = Filename.chop_extension (Filename.basename file) in
-    modname.[0] <- Char.uppercase modname.[0];
+    let modname =
+      String.capitalize (Filename.chop_extension (Filename.basename file))
+    in
     let key = (modname, file_kind) in
     let new_deps = ref [] in
     Hashtbl.add h key (file, new_deps);
@@ -414,7 +412,7 @@ let _ =
         " Show absolute filenames in error messages";
      "-all", Arg.Set all_dependencies,
         " Generate dependencies on all files";
-     "-I", Arg.String (fun s -> include_dirs := s :: !include_dirs),
+     "-I", Arg.String (fun s -> Clflags.include_dirs := s :: !Clflags.include_dirs),
         "<dir>  Add <dir> to the list of include directories";
      "-impl", Arg.String (file_dependencies_as ML),
         "<f>  Process <f> as a .ml file";
diff --git a/tools/ocamlmklib.ml b/tools/ocamlmklib.ml
index 0ef86979b9..77ae57becb 100644
--- a/tools/ocamlmklib.ml
+++ b/tools/ocamlmklib.ml
@@ -215,10 +215,14 @@ let prepostfix pre name post =
 let transl_path s =
   match Sys.os_type with
     | "Win32" ->
+        let s = Bytes.of_string s in
         let rec aux i =
-          if i = String.length s || s.[i] = ' ' then s
-          else (if s.[i] = '/' then s.[i] <- '\\'; aux (i + 1))
-        in aux 0
+          if i = Bytes.length s || Bytes.get s i = ' ' then s
+          else begin
+            if Bytes.get s i = '/' then Bytes.set s i '\\';
+            aux (i + 1)
+          end
+        in Bytes.to_string (aux 0)
     | _ -> s
 
 let build_libs () =
diff --git a/tools/ocamloptp.ml b/tools/ocamloptp.ml
index 6d730f2c3c..178f7c2d25 100644
--- a/tools/ocamloptp.ml
+++ b/tools/ocamloptp.ml
@@ -64,28 +64,32 @@ module Options = Main_args.Make_optcomp_options (struct
   let _keep_locs = option "-keep-locs"
   let _labels = option "-labels"
   let _linkall = option "-linkall"
+  let _no_alias_deps = option "-no-alias-deps"
   let _no_app_funct = option "-no-app-funct"
+  let _no_float_const_prop = option "-no-float-const-prop"
   let _noassert = option "-noassert"
   let _noautolink = option "-noautolink"
   let _nodynlink = option "-nodynlink"
   let _nolabels = option "-nolabels"
   let _nostdlib = option "-nostdlib"
   let _o s = option_with_arg "-o" s
+  let _open s = option_with_arg "-open" s
   let _output_obj = option "-output-obj"
   let _p = option "-p"
   let _pack = option "-pack"
-  let _pp s = incompatible "-pp"
-  let _ppx s = incompatible "-ppx"
+  let _pp _s = incompatible "-pp"
+  let _ppx _s = incompatible "-ppx"
   let _principal = option "-principal"
   let _rectypes = option "-rectypes"
   let _runtime_variant s = option_with_arg "-runtime-variant" s
   let _S = option "-S"
+  let _safe_string = option "-safe-string"
   let _short_paths = option "-short-paths"
   let _strict_sequence = option "-strict-sequence"
   let _shared = option "-shared"
   let _thread = option "-thread"
-  let _trans_mod = option "-trans-mod"
   let _unsafe = option "-unsafe"
+  let _unsafe_string = option "-unsafe-string"
   let _v = option "-v"
   let _version = option "-version"
   let _vnum = option "-vnum"
@@ -105,6 +109,7 @@ module Options = Main_args.Make_optcomp_options (struct
   let _dcmm = option "-dcmm"
   let _dsel = option "-dsel"
   let _dcombine = option "-dcombine"
+  let _dcse = option "-dcse"
   let _dlive = option "-dlive"
   let _dspill = option "-dspill"
   let _dsplit = option "-dsplit"
diff --git a/tools/ocamlprof.ml b/tools/ocamlprof.ml
index 1fde3fe495..9c2bb489dd 100644
--- a/tools/ocamlprof.ml
+++ b/tools/ocamlprof.ml
@@ -35,7 +35,7 @@ and inchan = ref stdin
 and outchan = ref stdout
 
 (* To copy source fragments *)
-let copy_buffer = String.create 256
+let copy_buffer = Bytes.create 256
 
 let copy_chars_unix nchars =
   let n = ref nchars in
@@ -173,8 +173,8 @@ and rewrite_exp iflag sexp =
 
 and rw_exp iflag sexp =
   match sexp.pexp_desc with
-    Pexp_ident lid -> ()
-  | Pexp_constant cst -> ()
+    Pexp_ident _lid -> ()
+  | Pexp_constant _cst -> ()
 
   | Pexp_let(_, spat_sexp_list, sbody) ->
     rewrite_patexp_list iflag spat_sexp_list;
@@ -314,7 +314,7 @@ and rewrite_annotate_exp_list l =
     l
 
 and rewrite_function iflag = function
-  | [{pc_lhs=spat; pc_guard=None;
+  | [{pc_lhs=_; pc_guard=None;
       pc_rhs={pexp_desc = (Pexp_function _|Pexp_fun _)} as sexp}] ->
         rewrite_exp iflag sexp
   | l -> rewrite_funmatching l
@@ -344,6 +344,7 @@ and rewrite_class_field iflag cf =
   | Pcf_method (_, _, Cfk_virtual _)
   | Pcf_val (_, _, Cfk_virtual _)
   | Pcf_constraint _  -> ()
+  | Pcf_attribute _ -> ()
   | Pcf_extension _ -> ()
 
 and rewrite_class_expr iflag cexpr =
@@ -370,11 +371,11 @@ and rewrite_class_declaration iflag cl =
 
 and rewrite_mod iflag smod =
   match smod.pmod_desc with
-    Pmod_ident lid -> ()
+    Pmod_ident _ -> ()
   | Pmod_structure sstr -> List.iter (rewrite_str_item iflag) sstr
-  | Pmod_functor(param, smty, sbody) -> rewrite_mod iflag sbody
+  | Pmod_functor(_param, _smty, sbody) -> rewrite_mod iflag sbody
   | Pmod_apply(smod1, smod2) -> rewrite_mod iflag smod1; rewrite_mod iflag smod2
-  | Pmod_constraint(smod, smty) -> rewrite_mod iflag smod
+  | Pmod_constraint(smod, _smty) -> rewrite_mod iflag smod
   | Pmod_unpack(sexp) -> rewrite_exp iflag sexp
   | Pmod_extension _ -> ()
 
diff --git a/tools/profiling.ml b/tools/profiling.ml
index 5dae8e4614..49a84108ec 100644
--- a/tools/profiling.ml
+++ b/tools/profiling.ml
@@ -37,7 +37,7 @@ let dump_counters () =
         then raise Bad_profile)
       !counters prevl;
     List.iter2
-      (fun (curname, (_,curcount)) (prevname, (_,prevcount)) ->
+      (fun (_curname, (_,curcount)) (_prevname, (_,prevcount)) ->
         for i = 0 to Array.length curcount - 1 do
           curcount.(i) <- curcount.(i) + prevcount.(i)
         done)
diff --git a/tools/read_cmt.ml b/tools/read_cmt.ml
index 0ff9f3df77..eacba02a50 100644
--- a/tools/read_cmt.ml
+++ b/tools/read_cmt.ml
@@ -27,6 +27,8 @@ let arg_list = [
 let arg_usage =
   "read_cmt [OPTIONS] FILE.cmt : read FILE.cmt and print related information"
 
+let dummy_crc = String.make 32 '-'
+
 let print_info cmt =
   let open Cmt_format in
       Printf.printf "module name: %s\n" cmt.cmt_modname;
@@ -60,8 +62,13 @@ let print_info cmt =
         | Some digest ->
             Printf.printf "interface digest: %s\n" (Digest.to_hex digest);
       end;
-      List.iter (fun (name, digest) ->
-        Printf.printf "import: %s %s\n" name (Digest.to_hex digest);
+      List.iter (fun (name, crco) ->
+        let crc =
+          match crco with
+            None -> dummy_crc
+          | Some crc -> Digest.to_hex crc
+        in
+          Printf.printf "import: %s %s\n" name crc;
       ) (List.sort compare cmt.cmt_imports);
       Printf.printf "%!";
       ()
diff --git a/tools/tast_iter.ml b/tools/tast_iter.ml
index f640ccaf79..be5b854419 100644
--- a/tools/tast_iter.ml
+++ b/tools/tast_iter.ml
@@ -17,21 +17,14 @@ let opt f = function None -> () | Some x -> f x
 let structure sub str =
   List.iter (sub # structure_item) str.str_items
 
-let constructor_decl sub cd =
-  begin match cd.cd_args with
-  | Cstr_tuple l -> List.iter (sub # core_type) l
-  | Cstr_record l -> List.iter (fun ld -> sub # core_type ld.ld_type) l
-  end;
-  opt (sub # core_type) cd.cd_res
-
 let structure_item sub x =
   match x.str_desc with
   | Tstr_eval (exp, _attrs) -> sub # expression exp
   | Tstr_value (rec_flag, list) -> sub # bindings (rec_flag, list)
   | Tstr_primitive v -> sub # value_description v
   | Tstr_type list -> List.iter (sub # type_declaration) list
-  | Tstr_exception decl -> constructor_decl sub decl
-  | Tstr_exn_rebind _ -> ()
+  | Tstr_typext te -> sub # type_extension te
+  | Tstr_exception ext -> sub # extension_constructor ext
   | Tstr_module mb -> sub # module_binding mb
   | Tstr_recmodule list -> List.iter (sub # module_binding) list
   | Tstr_modtype mtd -> opt (sub # module_type) mtd.mtd_type
@@ -46,6 +39,17 @@ let structure_item sub x =
 let value_description sub x =
   sub # core_type x.val_desc
 
+let constructor_args sub = function
+  | Cstr_tuple l -> List.iter (sub # core_type) l
+  | Cstr_record l -> List.iter (fun ld -> sub # core_type ld.ld_type) l
+
+let constructor_decl sub cd =
+  constructor_args sub cd.cd_args;
+  opt (sub # core_type) cd.cd_res
+
+let label_decl sub ld =
+  sub # core_type ld.ld_type
+
 let type_declaration sub decl =
   List.iter
     (fun (ct1, ct2, _loc) -> sub # core_type ct1; sub # core_type ct2)
@@ -55,10 +59,21 @@ let type_declaration sub decl =
   | Ttype_variant list ->
       List.iter (constructor_decl sub) list
   | Ttype_record list ->
-      List.iter (fun ld -> sub # core_type ld.ld_type) list
+      List.iter (label_decl sub) list
+  | Ttype_open -> ()
   end;
   opt (sub # core_type) decl.typ_manifest
 
+let type_extension sub te =
+  List.iter (sub # extension_constructor) te.tyext_constructors
+
+let extension_constructor sub ext =
+  match ext.ext_kind with
+    Text_decl(ctl, cto) ->
+      constructor_args sub ctl;
+      opt (sub # core_type) cto
+  | Text_rebind _ -> ()
+
 let pattern sub pat =
   let extra = function
     | Tpat_type _
@@ -101,9 +116,10 @@ let expression sub exp =
   | Texp_apply (exp, list) ->
       sub # expression exp;
       List.iter (fun (_, expo, _) -> opt (sub # expression) expo) list
-  | Texp_match (exp, cases, _) ->
+  | Texp_match (exp, cases, exn_cases, _) ->
       sub # expression exp;
-      sub # cases cases
+      sub # cases cases;
+      sub # cases exn_cases
   | Texp_try (exp, cases) ->
       sub # expression exp;
       sub # cases cases
@@ -169,8 +185,10 @@ let signature_item sub item =
       sub # value_description v
   | Tsig_type list ->
       List.iter (sub # type_declaration) list
-  | Tsig_exception decl ->
-      constructor_decl sub decl
+  | Tsig_typext te ->
+      sub # type_extension te
+  | Tsig_exception ext ->
+      sub # extension_constructor ext
   | Tsig_module md ->
       sub # module_type md.md_type
   | Tsig_recmodule list ->
@@ -277,6 +295,7 @@ let class_type_field sub ctf =
   | Tctf_constraint  (ct1, ct2) ->
       sub # core_type ct1;
       sub # core_type ct2
+  | Tctf_attribute _ -> ()
 
 let core_type sub ct =
   match ct.ctyp_desc with
@@ -289,7 +308,7 @@ let core_type sub ct =
   | Ttyp_constr (_path, _, list) ->
       List.iter (sub # core_type) list
   | Ttyp_object (list, _o) ->
-      List.iter (fun (_, t) -> sub # core_type t) list
+      List.iter (fun (_, _, t) -> sub # core_type t) list
   | Ttyp_class (_path, _, list) ->
       List.iter (sub # core_type) list
   | Ttyp_alias (ct, _s) ->
@@ -305,7 +324,7 @@ let class_structure sub cs =
 
 let row_field sub rf =
   match rf with
-  | Ttag (_label, _bool, list) -> List.iter (sub # core_type) list
+  | Ttag (_label, _attrs, _bool, list) -> List.iter (sub # core_type) list
   | Tinherit ct -> sub # core_type ct
 
 let class_field sub cf =
@@ -325,6 +344,7 @@ let class_field sub cf =
       sub # expression exp
   | Tcf_initializer exp ->
       sub # expression exp
+  | Tcf_attribute _ -> ()
 
 let bindings sub (_rec_flag, list) =
   List.iter (sub # binding) list
@@ -356,6 +376,7 @@ class iter = object(this)
   method class_type_field = class_type_field this
   method core_type = core_type this
   method expression = expression this
+  method extension_constructor = extension_constructor this
   method module_binding = module_binding this
   method module_expr = module_expr this
   method module_type = module_type this
@@ -367,6 +388,7 @@ class iter = object(this)
   method structure = structure this
   method structure_item = structure_item this
   method type_declaration = type_declaration this
+  method type_extension = type_extension this
   method value_description = value_description this
   method with_constraint = with_constraint this
 end
diff --git a/tools/tast_iter.mli b/tools/tast_iter.mli
index f80609566b..1d81afa568 100644
--- a/tools/tast_iter.mli
+++ b/tools/tast_iter.mli
@@ -28,6 +28,7 @@ class iter: object
   method class_type_field: class_type_field -> unit
   method core_type: core_type -> unit
   method expression: expression -> unit
+  method extension_constructor: extension_constructor -> unit
   method module_binding: module_binding -> unit
   method module_expr: module_expr -> unit
   method module_type: module_type -> unit
@@ -39,6 +40,7 @@ class iter: object
   method structure: structure -> unit
   method structure_item: structure_item -> unit
   method type_declaration: type_declaration -> unit
+  method type_extension: type_extension -> unit
   method value_description: value_description -> unit
   method with_constraint: with_constraint -> unit
 end
@@ -63,6 +65,7 @@ val class_type_declaration: iter -> class_type_declaration -> unit
 val class_type_field: iter -> class_type_field -> unit
 val core_type: iter -> core_type -> unit
 val expression: iter -> expression -> unit
+val extension_constructor: iter -> extension_constructor -> unit
 val module_binding: iter -> module_binding -> unit
 val module_expr: iter -> module_expr -> unit
 val module_type: iter -> module_type -> unit
@@ -74,5 +77,6 @@ val signature_item: iter -> signature_item -> unit
 val structure: iter -> structure -> unit
 val structure_item: iter -> structure_item -> unit
 val type_declaration: iter -> type_declaration -> unit
+val type_extension: iter -> type_extension -> unit
 val value_description: iter -> value_description -> unit
 val with_constraint: iter -> with_constraint -> unit
diff --git a/tools/untypeast.ml b/tools/untypeast.ml
index c6c7b3bc9e..b59443c595 100644
--- a/tools/untypeast.ml
+++ b/tools/untypeast.ml
@@ -53,10 +53,10 @@ and untype_structure_item item =
         Pstr_primitive (untype_value_description vd)
     | Tstr_type list ->
         Pstr_type (List.map untype_type_declaration list)
-    | Tstr_exception decl ->
-        Pstr_exception (untype_constructor_declaration decl)
-    | Tstr_exn_rebind er ->
-        Pstr_exn_rebind (untype_exception_rebind er)
+    | Tstr_typext tyext ->
+        Pstr_typext (untype_type_extension tyext)
+    | Tstr_exception ext ->
+        Pstr_exception (untype_extension_constructor ext)
     | Tstr_module mb ->
         Pstr_module (untype_module_binding mb)
     | Tstr_recmodule list ->
@@ -71,26 +71,15 @@ and untype_structure_item item =
                    popen_loc = od.open_loc;
                   }
     | Tstr_class list ->
-        Pstr_class (List.map (fun (ci, _, _) ->
-              { pci_virt = ci.ci_virt;
-                pci_params = ci.ci_params;
-                pci_name = ci.ci_id_name;
-                pci_expr = untype_class_expr ci.ci_expr;
-                pci_loc = ci.ci_loc;
-                pci_attributes = ci.ci_attributes;
-              }
-          ) list)
+        Pstr_class
+          (List.map
+             (fun (ci, _, _) -> untype_class_declaration ci)
+             list)
     | Tstr_class_type list ->
-        Pstr_class_type (List.map (fun (_id, _name, ct) ->
-              {
-                pci_virt = ct.ci_virt;
-                pci_params = ct.ci_params;
-                pci_name = ct.ci_id_name;
-                pci_expr = untype_class_type ct.ci_expr;
-                pci_loc = ct.ci_loc;
-                pci_attributes = ct.ci_attributes;
-              }
-          ) list)
+        Pstr_class_type
+          (List.map
+             (fun (_id, _name, ct) -> untype_class_type_declaration ct)
+             list)
     | Tstr_include incl ->
         Pstr_include {pincl_mod = untype_module_expr incl.incl_mod;
                       pincl_attributes = incl.incl_attributes;
@@ -121,7 +110,7 @@ and untype_module_binding mb =
 and untype_type_declaration decl =
   {
     ptype_name = decl.typ_name;
-    ptype_params = decl.typ_params;
+    ptype_params = List.map untype_type_parameter decl.typ_params;
     ptype_cstrs = List.map (fun (ct1, ct2, loc) ->
         (untype_core_type ct1,
           untype_core_type ct2, loc)
@@ -132,6 +121,7 @@ and untype_type_declaration decl =
           Ptype_variant (List.map untype_constructor_declaration list)
       | Ttype_record list ->
           Ptype_record (List.map untype_label_declaration list)
+      | Ttype_open -> Ptype_open
     );
     ptype_private = decl.typ_private;
     ptype_manifest = option untype_core_type decl.typ_manifest;
@@ -139,33 +129,51 @@ and untype_type_declaration decl =
     ptype_loc = decl.typ_loc;
   }
 
+and untype_type_parameter (ct, v) = (untype_core_type ct, v)
+
+and untype_constructor_arguments = function
+   | Cstr_tuple l -> Pcstr_tuple (List.map untype_core_type l)
+   | Cstr_record l -> Pcstr_record (List.map untype_label_declaration l)
+
+and untype_constructor_declaration cd =
+  {
+   pcd_name = cd.cd_name;
+   pcd_args = untype_constructor_arguments cd.cd_args;
+   pcd_res = option untype_core_type cd.cd_res;
+   pcd_loc = cd.cd_loc;
+   pcd_attributes = cd.cd_attributes;
+  }
+
 and untype_label_declaration ld =
   {
     pld_name=ld.ld_name;
     pld_mutable=ld.ld_mutable;
     pld_type=untype_core_type ld.ld_type;
     pld_loc=ld.ld_loc;
-    pld_attributes=ld.ld_attributes;
+    pld_attributes=ld.ld_attributes
   }
 
-and untype_constructor_declaration cd =
+and untype_type_extension tyext =
   {
-   pcd_name = cd.cd_name;
-   pcd_args = begin match cd.cd_args with
-   | Cstr_tuple l -> Pcstr_tuple (List.map untype_core_type l)
-   | Cstr_record l -> Pcstr_record (List.map untype_label_declaration l)
-   end;
-   pcd_res = option untype_core_type cd.cd_res;
-   pcd_loc = cd.cd_loc;
-   pcd_attributes = cd.cd_attributes;
+    ptyext_path = tyext.tyext_txt;
+    ptyext_params = List.map untype_type_parameter tyext.tyext_params;
+    ptyext_constructors =
+      List.map untype_extension_constructor tyext.tyext_constructors;
+    ptyext_private = tyext.tyext_private;
+    ptyext_attributes = tyext.tyext_attributes;
   }
 
-and untype_exception_rebind er =
+and untype_extension_constructor ext =
   {
-   pexrb_name = er.exrb_name;
-   pexrb_lid = er.exrb_txt;
-   pexrb_attributes = er.exrb_attributes;
-   pexrb_loc = er.exrb_loc;
+    pext_name = ext.ext_name;
+    pext_kind = (match ext.ext_kind with
+        Text_decl (args, ret) ->
+          Pext_decl (untype_constructor_arguments args,
+                     option untype_core_type ret)
+      | Text_rebind (_p, lid) -> Pext_rebind lid
+    );
+    pext_loc = ext.ext_loc;
+    pext_attributes = ext.ext_attributes;
   }
 
 and untype_pattern pat =
@@ -270,8 +278,18 @@ and untype_expression exp =
                 None -> list
               | Some exp -> (label, untype_expression exp) :: list
           ) list [])
-    | Texp_match (exp, cases, _) ->
-        Pexp_match (untype_expression exp, untype_cases cases)
+    | Texp_match (exp, cases, exn_cases, _) ->
+      let merged_cases = untype_cases cases
+        @ List.map
+          (fun c ->
+            let uc = untype_case c in
+            let pat = { uc.pc_lhs
+                        with ppat_desc = Ppat_exception uc.pc_lhs }
+            in
+            { uc with pc_lhs = pat })
+          exn_cases
+      in 
+      Pexp_match (untype_expression exp, merged_cases)
     | Texp_try (exp, cases) ->
         Pexp_try (untype_expression exp, untype_cases cases)
     | Texp_tuple list ->
@@ -352,8 +370,10 @@ and untype_signature_item item =
         Psig_value (untype_value_description v)
     | Tsig_type list ->
         Psig_type (List.map untype_type_declaration list)
-    | Tsig_exception decl ->
-        Psig_exception (untype_constructor_declaration decl)
+    | Tsig_typext tyext ->
+        Psig_typext (untype_type_extension tyext)
+    | Tsig_exception ext ->
+        Psig_exception (untype_extension_constructor ext)
     | Tsig_module md ->
         Psig_module {pmd_name = md.md_name;
                      pmd_type = untype_module_type md.md_type;
@@ -389,10 +409,20 @@ and untype_signature_item item =
     psig_loc = item.sig_loc;
   }
 
+and untype_class_declaration cd =
+  {
+    pci_virt = cd.ci_virt;
+    pci_params = List.map untype_type_parameter cd.ci_params;
+    pci_name = cd.ci_id_name;
+    pci_expr = untype_class_expr cd.ci_expr;
+    pci_loc = cd.ci_loc;
+    pci_attributes = cd.ci_attributes;
+  }
+
 and untype_class_description cd =
   {
     pci_virt = cd.ci_virt;
-    pci_params = cd.ci_params;
+    pci_params = List.map untype_type_parameter cd.ci_params;
     pci_name = cd.ci_id_name;
     pci_expr = untype_class_type cd.ci_expr;
     pci_loc = cd.ci_loc;
@@ -402,7 +432,7 @@ and untype_class_description cd =
 and untype_class_type_declaration cd =
   {
     pci_virt = cd.ci_virt;
-    pci_params = cd.ci_params;
+    pci_params = List.map untype_type_parameter cd.ci_params;
     pci_name = cd.ci_id_name;
     pci_expr = untype_class_type cd.ci_expr;
     pci_loc = cd.ci_loc;
@@ -523,6 +553,7 @@ and untype_class_type_field ctf =
         Pctf_method  (s, priv, virt, untype_core_type ct)
     | Tctf_constraint  (ct1, ct2) ->
         Pctf_constraint (untype_core_type ct1, untype_core_type ct2)
+    | Tctf_attribute x -> Pctf_attribute x
   in
   {
     pctf_desc = desc;
@@ -541,7 +572,8 @@ and untype_core_type ct =
         Ptyp_constr (lid,
           List.map untype_core_type list)
     | Ttyp_object (list, o) ->
-        Ptyp_object (List.map (fun (s, t) -> (s, untype_core_type t)) list, o)
+        Ptyp_object
+          (List.map (fun (s, a, t) -> (s, a, untype_core_type t)) list, o)
     | Ttyp_class (_path, lid, list) ->
         Ptyp_class (lid, List.map untype_core_type list)
     | Ttyp_alias (ct, s) ->
@@ -560,8 +592,8 @@ and untype_class_structure cs =
 
 and untype_row_field rf =
   match rf with
-    Ttag (label, bool, list) ->
-      Rtag (label, bool, List.map untype_core_type list)
+    Ttag (label, attrs, bool, list) ->
+      Rtag (label, attrs, bool, List.map untype_core_type list)
   | Tinherit ct -> Rinherit (untype_core_type ct)
 
 and untype_class_field cf =
@@ -579,5 +611,6 @@ and untype_class_field cf =
     | Tcf_method (lab, priv, Tcfk_concrete (o, exp)) ->
         Pcf_method (lab, priv, Cfk_concrete (o, untype_expression exp))
     | Tcf_initializer exp -> Pcf_initializer (untype_expression exp)
+    | Tcf_attribute x -> Pcf_attribute x
   in
   { pcf_desc = desc; pcf_loc = cf.cf_loc; pcf_attributes = cf.cf_attributes }
diff --git a/toplevel/expunge.ml b/toplevel/expunge.ml
index fa6fd7ca5a..a893c60ddc 100644
--- a/toplevel/expunge.ml
+++ b/toplevel/expunge.ml
@@ -65,7 +65,7 @@ let main () =
           let global_map = (input_value ic : Symtable.global_map) in
           output_value oc (expunge_map global_map)
       | "CRCS" ->
-          let crcs = (input_value ic : (string * Digest.t) list) in
+          let crcs = (input_value ic : (string * Digest.t option) list) in
           output_value oc (expunge_crcs crcs)
       | _ ->
           copy_file_chunk ic oc len
diff --git a/toplevel/genprintval.ml b/toplevel/genprintval.ml
index 2ebff822fa..6519d3941c 100644
--- a/toplevel/genprintval.ml
+++ b/toplevel/genprintval.ml
@@ -50,6 +50,15 @@ module type S =
           Env.t -> t -> type_expr -> Outcometree.out_value
   end
 
+module ObjTbl = Hashtbl.Make(struct
+        type t = Obj.t
+        let equal = (==)
+        let hash x =
+          try
+            Hashtbl.hash x
+          with exn -> 0
+      end)
+
 module Make(O : OBJ)(EVP : EVALPATH with type valu = O.t) = struct
 
     type t = O.t
@@ -173,6 +182,24 @@ module Make(O : OBJ)(EVP : EVALPATH with type valu = O.t) = struct
 
       let printer_steps = ref max_steps in
 
+      let nested_values = ObjTbl.create 8 in
+      let nest_gen err f depth obj ty =
+        let repr = Obj.repr obj in
+        if not (Obj.is_block repr) then
+          f depth obj ty
+        else
+          if ObjTbl.mem nested_values repr then
+            err
+          else begin
+            ObjTbl.add nested_values repr ();
+            let ret = f depth obj ty in
+            ObjTbl.remove nested_values repr;
+            ret
+          end
+      in
+
+      let nest f = nest_gen (Oval_stuff "<cycle>") f in
+
       let rec tree_of_val depth obj ty =
         decr printer_steps;
         if !printer_steps < 0 || depth < 0 then Oval_ellipsis
@@ -187,25 +214,26 @@ module Make(O : OBJ)(EVP : EVALPATH with type valu = O.t) = struct
               Oval_stuff "<fun>"
           | Ttuple(ty_list) ->
               Oval_tuple (tree_of_val_list 0 depth obj ty_list)
-          | Tconstr(path, [], _) when Path.same path Predef.path_exn ->
-              tree_of_exception depth obj
           | Tconstr(path, [ty_arg], _)
             when Path.same path Predef.path_list ->
               if O.is_block obj then
                 match check_depth depth obj ty with
                   Some x -> x
                 | None ->
-                    let rec tree_of_conses tree_list obj =
+                    let rec tree_of_conses tree_list depth obj ty_arg =
                       if !printer_steps < 0 || depth < 0 then
                         Oval_ellipsis :: tree_list
                       else if O.is_block obj then
                         let tree =
-                          tree_of_val (depth - 1) (O.field obj 0) ty_arg in
+                          nest tree_of_val (depth - 1) (O.field obj 0) ty_arg
+                        in
                         let next_obj = O.field obj 1 in
-                        tree_of_conses (tree :: tree_list) next_obj
+                        nest_gen (Oval_stuff "<cycle>" :: tree :: tree_list)
+                          (tree_of_conses (tree :: tree_list))
+                          depth next_obj ty_arg
                       else tree_list
                     in
-                    Oval_list (List.rev (tree_of_conses [] obj))
+                    Oval_list (List.rev (tree_of_conses [] depth obj ty_arg))
               else
                 Oval_list []
           | Tconstr(path, [ty_arg], _)
@@ -220,7 +248,8 @@ module Make(O : OBJ)(EVP : EVALPATH with type valu = O.t) = struct
                         Oval_ellipsis :: tree_list
                       else if i < length then
                         let tree =
-                          tree_of_val (depth - 1) (O.field obj i) ty_arg in
+                          nest tree_of_val (depth - 1) (O.field obj i) ty_arg
+                        in
                         tree_of_items (tree :: tree_list) (i + 1)
                       else tree_list
                     in
@@ -230,11 +259,13 @@ module Make(O : OBJ)(EVP : EVALPATH with type valu = O.t) = struct
           | Tconstr (path, [ty_arg], _)
             when Path.same path Predef.path_lazy_t ->
               if Lazy.lazy_is_val (O.obj obj)
-              then let v = tree_of_val depth (Lazy.force (O.obj obj)) ty_arg in
-                   Oval_constr (Oide_ident "lazy", [v])
+              then let v =
+                     nest tree_of_val depth (Lazy.force (O.obj obj)) ty_arg
+                   in
+                     Oval_constr (Oide_ident "lazy", [v])
               else Oval_stuff "<lazy>"
-          | Tconstr(path, ty_list, _) ->
-              begin try
+          | Tconstr(path, ty_list, _) -> begin
+              try
                 let decl = Env.find_type path env in
                 match decl with
                 | {type_kind = Type_abstract; type_manifest = None} ->
@@ -288,13 +319,15 @@ module Make(O : OBJ)(EVP : EVALPATH with type valu = O.t) = struct
                     | None ->
                         let pos =
                           match rep with
-                          | Record_exception _ -> 1
+                          | Record_extension _ -> 1
                           | _ -> 0
                         in
                         tree_of_record_fields depth
                           env path decl.type_params ty_list
                           lbl_list pos
                     end
+                | {type_kind = Type_open} ->
+                    tree_of_extension path depth obj
               with
                 Not_found ->                (* raised by Env.find_type *)
                   Oval_stuff "<abstr>"
@@ -311,8 +344,9 @@ module Make(O : OBJ)(EVP : EVALPATH with type valu = O.t) = struct
                         match Btype.row_field_repr f with
                         | Rpresent(Some ty) | Reither(_,[ty],_,_) ->
                             let args =
-                              tree_of_val (depth - 1) (O.field obj 1) ty in
-                            Oval_variant (l, Some args)
+                              nest tree_of_val (depth - 1) (O.field obj 1) ty
+                            in
+                              Oval_variant (l, Some args)
                         | _ -> find fields
                       else find fields
                   | [] -> Oval_stuff "<variant>" in
@@ -356,7 +390,7 @@ module Make(O : OBJ)(EVP : EVALPATH with type valu = O.t) = struct
                 if pos = 0 then tree_of_label env path name
                 else Oide_ident name
               and v =
-                tree_of_val (depth - 1) (O.field obj pos)
+                nest tree_of_val (depth - 1) (O.field obj pos)
                   ty_arg
               in
               (lid, v) :: tree_of_fields (pos + 1) remainder
@@ -367,7 +401,7 @@ module Make(O : OBJ)(EVP : EVALPATH with type valu = O.t) = struct
         let rec tree_list i = function
           | [] -> []
           | ty :: ty_list ->
-              let tree = tree_of_val (depth - 1) (O.field obj i) ty in
+              let tree = nest tree_of_val (depth - 1) (O.field obj i) ty in
               tree :: tree_list (i + 1) ty_list in
       tree_list start ty_list
 
@@ -384,7 +418,7 @@ module Make(O : OBJ)(EVP : EVALPATH with type valu = O.t) = struct
         in
         Oval_constr (lid, args)
 
-    and tree_of_exception depth bucket =
+    and tree_of_extension type_path depth bucket =
       let slot =
         if O.tag bucket <> 0 then bucket
         else O.field bucket 0
@@ -397,7 +431,9 @@ module Make(O : OBJ)(EVP : EVALPATH with type valu = O.t) = struct
         let cstr = Env.lookup_constructor lid env in
         let path =
           match cstr.cstr_tag with
-            Cstr_exception (p, _) -> p | _ -> raise Not_found in
+            Cstr_extension(p, _) -> p
+            | _ -> raise Not_found
+        in
         (* Make sure this is the right exception and not an homonym,
            by evaluating the exception found and comparing with the
            identifier contained in the exception bucket *)
@@ -409,8 +445,11 @@ module Make(O : OBJ)(EVP : EVALPATH with type valu = O.t) = struct
       with Not_found | EVP.Error ->
         match check_depth depth bucket ty with
           Some x -> x
-        | None -> outval_of_untyped_exception bucket
+        | None when Path.same type_path Predef.path_exn->
+            outval_of_untyped_exception bucket
+        | None ->
+            Oval_stuff "<extension>"
 
-    in tree_of_val max_depth obj ty
+    in nest tree_of_val max_depth obj ty
 
 end
diff --git a/toplevel/opttoploop.ml b/toplevel/opttoploop.ml
index 5bac897810..9e9e3d7447 100644
--- a/toplevel/opttoploop.ml
+++ b/toplevel/opttoploop.ml
@@ -92,6 +92,7 @@ let print_out_value = Oprint.out_value
 let print_out_type = Oprint.out_type
 let print_out_class_type = Oprint.out_class_type
 let print_out_module_type = Oprint.out_module_type
+let print_out_type_extension = Oprint.out_type_extension
 let print_out_sig_item = Oprint.out_sig_item
 let print_out_signature = Oprint.out_signature
 let print_out_phrase = Oprint.out_phrase
@@ -171,8 +172,8 @@ let rec pr_item env = function
   | Sig_type(id, decl, rs) :: rem ->
       let tree = Printtyp.tree_of_type_declaration id decl rs in
       Some (tree, None, rem)
-  | Sig_exception(id, decl) :: rem ->
-      let tree = Printtyp.tree_of_exception_declaration id decl in
+  | Sig_typext(id, ext, es) :: rem ->
+      let tree = Printtyp.tree_of_extension_constructor id ext es in
       Some (tree, None, rem)
   | Sig_module(id, mty, rs) :: rem ->
       let tree = Printtyp.tree_of_module id mty rs in
diff --git a/toplevel/opttoploop.mli b/toplevel/opttoploop.mli
index 3be9a51ea8..2236255818 100644
--- a/toplevel/opttoploop.mli
+++ b/toplevel/opttoploop.mli
@@ -84,6 +84,8 @@ val print_out_class_type :
   (formatter -> Outcometree.out_class_type -> unit) ref
 val print_out_module_type :
   (formatter -> Outcometree.out_module_type -> unit) ref
+val print_out_type_extension :
+  (formatter -> Outcometree.out_type_extension -> unit) ref
 val print_out_sig_item :
   (formatter -> Outcometree.out_sig_item -> unit) ref
 val print_out_signature :
diff --git a/toplevel/opttopmain.ml b/toplevel/opttopmain.ml
index 3e15c1988d..941c3ec26b 100644
--- a/toplevel/opttopmain.ml
+++ b/toplevel/opttopmain.ml
@@ -69,6 +69,7 @@ module Options = Main_args.Make_opttop_options (struct
   let _init s = init_file := Some s
   let _inline n = inline_threshold := n * 8
   let _labels = clear classic
+  let _no_alias_deps = set transparent_modules
   let _no_app_funct = clear applicative_functors
   let _noassert = set noassert
   let _nolabels = set classic
diff --git a/toplevel/topdirs.ml b/toplevel/topdirs.ml
index 873e795850..5fdaa2cb50 100644
--- a/toplevel/topdirs.ml
+++ b/toplevel/topdirs.ml
@@ -61,7 +61,12 @@ exception Load_failed
 let check_consistency ppf filename cu =
   try
     List.iter
-      (fun (name, crc) -> Consistbl.check Env.crc_units name crc filename)
+      (fun (name, crco) ->
+       Env.imported_units := name :: !Env.imported_units;
+       match crco with
+         None -> ()
+       | Some crc->
+           Consistbl.check Env.crc_units name crc filename)
       cu.cu_imports
   with Consistbl.Inconsistency(name, user, auth) ->
     fprintf ppf "@[<hv 0>The files %s@ and %s@ \
@@ -75,7 +80,7 @@ let load_compunit ic filename ppf compunit =
   let code_size = compunit.cu_codesize + 8 in
   let code = Meta.static_alloc code_size in
   unsafe_really_input ic code 0 compunit.cu_codesize;
-  String.unsafe_set code compunit.cu_codesize (Char.chr Opcodes.opRETURN);
+  Bytes.unsafe_set code compunit.cu_codesize (Char.chr Opcodes.opRETURN);
   String.unsafe_blit "\000\000\000\001\000\000\000" 0
                      code (compunit.cu_codesize + 1) 7;
   let initial_symtable = Symtable.current_state() in
@@ -110,7 +115,7 @@ let rec load_file recursive ppf name =
 
 and really_load_file recursive ppf name filename ic =
   let ic = open_in_bin filename in
-  let buffer = Misc.input_bytes ic (String.length Config.cmo_magic_number) in
+  let buffer = really_input_string ic (String.length Config.cmo_magic_number) in
   try
     if buffer = Config.cmo_magic_number then begin
       let compunit_pos = input_binary_int ic in  (* Go to descriptor *)
@@ -340,70 +345,108 @@ let trim_signature = function
            sg)
   | mty -> mty
 
-let dir_show ppf args =
-  let open Parsetree in
-  let id lid =
-    let s = match lid with
-        Longident.Lident s -> s
+let show_prim to_sig ppf lid =
+  let env = !Toploop.toplevel_env in
+  let loc = Location.none in
+  try
+    let s =
+      match lid with
+      | Longident.Lident s -> s
       | Longident.Ldot (_,s) -> s
       | Longident.Lapply _ ->
           fprintf ppf "Invalid path %a@." Printtyp.longident lid;
           raise Exit
     in
-    Ident.create_persistent s
-  in
-  let env = !Toploop.toplevel_env in
-  try
-    let loc = Location.none in
-    let item =
-      match args with
-      | [ Pdir_keyword "val"; Pdir_ident lid ] ->
-          let id = id lid in
-          let path, desc = Typetexp.find_value env loc lid in
-          Sig_value (id, desc)
-      | [ Pdir_keyword "type"; Pdir_ident lid ] ->
-          let id = id lid in
-          let path, desc = Typetexp.find_type env loc lid in
-          Sig_type (id, desc, Trec_not)
-      | [ Pdir_keyword "exception"; Pdir_ident lid ] ->
-          let id = id lid in
-          let desc = Typetexp.find_constructor env loc lid in
-          begin match desc.cstr_tag with
-          | Cstr_constant _ | Cstr_block _ ->
-              fprintf ppf "@[This constructor is not an exception.@]@.";
-              raise Exit
-          | Cstr_exception _ ->
-              Sig_exception (id, {exn_args=Cstr_tuple desc.cstr_args;
-                                  exn_loc=desc.cstr_loc;
-                                  exn_attributes=desc.cstr_attributes;
-                                 })
-          end
-      | [ Pdir_keyword "module"; Pdir_ident lid ] ->
-          let id = id lid in
-          let path = Typetexp.find_module env loc lid in
-          let md = Env.find_module path env in
-          Sig_module (id, {md with md_type = trim_signature md.md_type},
-                      Trec_not)
-      | [ Pdir_keyword "module"; Pdir_keyword "type"; Pdir_ident lid ] ->
-          let id = id lid in
-          let path, desc = Typetexp.find_modtype env loc lid in
-          Sig_modtype (id, desc)
-      | [ Pdir_keyword "class"; Pdir_ident lid ] ->
-          let id = id lid in
-          let path, desc = Typetexp.find_class env loc lid in
-          Sig_class (id, desc, Trec_not)
-      | [ Pdir_keyword "class"; Pdir_keyword "type"; Pdir_ident lid ] ->
-          let id = id lid in
-          let path, desc = Typetexp.find_class_type env loc lid in
-          Sig_class_type (id, desc, Trec_not)
-      | _ -> fprintf ppf "@[Bad usage for #show@]@."; raise Exit
-    in
-    fprintf ppf "@[%a@]@." Printtyp.signature [item]
+    let id = Ident.create_persistent s in
+    let sg = to_sig env loc id lid in
+    fprintf ppf "@[%a@]@." Printtyp.signature sg
   with
   | Not_found ->
       fprintf ppf "@[Unknown element.@]@."
-  | Exit ->
-      ()
+  | Exit -> ()
+
+let all_show_funs = ref []
+
+let reg_show_prim name to_sig =
+  all_show_funs := to_sig :: !all_show_funs;
+  Hashtbl.add directive_table name (Directive_ident (show_prim to_sig std_out))
+
+let () =
+  reg_show_prim "show_val"
+    (fun env loc id lid ->
+       let path, desc = Typetexp.find_value env loc lid in
+       [ Sig_value (id, desc) ]
+    )
+
+let () =
+  reg_show_prim "show_type"
+    (fun env loc id lid ->
+       let path, desc = Typetexp.find_type env loc lid in
+       [ Sig_type (id, desc, Trec_not) ]
+    )
+
+let () =
+  reg_show_prim "show_exception"
+    (fun env loc id lid ->
+       let desc = Typetexp.find_constructor env loc lid in
+       if not (Ctype.equal env true [desc.cstr_res] [Predef.type_exn]) then
+         raise Not_found;
+       let ret_type =
+         if desc.cstr_generalized then Some Predef.type_exn
+         else None
+       in
+       let ext =
+         { ext_type_path = Predef.path_exn;
+           ext_type_params = [];
+           ext_args = Cstr_tuple desc.cstr_args;
+           ext_ret_type = ret_type;
+           ext_private = Asttypes.Public;
+           Types.ext_loc = desc.cstr_loc;
+           Types.ext_attributes = desc.cstr_attributes; }
+       in
+         [Sig_typext (id, ext, Text_exception)]
+    )
+
+let () =
+  reg_show_prim "show_module"
+    (fun env loc id lid ->
+       let path, md = Typetexp.find_module env loc lid in
+       [ Sig_module (id, {md with md_type = trim_signature md.md_type},
+                     Trec_not) ]
+    )
+
+let () =
+  reg_show_prim "show_module_type"
+    (fun env loc id lid ->
+       let path, desc = Typetexp.find_modtype env loc lid in
+       [ Sig_modtype (id, desc) ]
+    )
+
+let () =
+  reg_show_prim "show_class"
+    (fun env loc id lid ->
+       let path, desc = Typetexp.find_class env loc lid in
+       [ Sig_class (id, desc, Trec_not) ]
+    )
+
+let () =
+  reg_show_prim "show_class_type"
+    (fun env loc id lid ->
+       let path, desc = Typetexp.find_class_type env loc lid in
+       [ Sig_class_type (id, desc, Trec_not) ]
+    )
+
+
+let show env loc id lid =
+  let sg =
+    List.fold_left
+      (fun sg f -> try (f env loc id lid) @ sg with _ -> sg)
+      [] !all_show_funs
+  in
+  if sg = [] then raise Not_found else sg
+
+let () =
+  Hashtbl.add directive_table "show" (Directive_ident (show_prim show std_out))
 
 let _ =
   Hashtbl.add directive_table "trace" (Directive_ident (dir_trace std_out));
@@ -429,13 +472,13 @@ let _ =
   Hashtbl.add directive_table "rectypes"
              (Directive_none(fun () -> Clflags.recursive_types := true));
 
+  Hashtbl.add directive_table "ppx"
+    (Directive_string(fun s -> Clflags.all_ppx := s :: !Clflags.all_ppx));
+
   Hashtbl.add directive_table "warnings"
              (Directive_string (parse_warnings std_out false));
 
   Hashtbl.add directive_table "warn_error"
              (Directive_string (parse_warnings std_out true));
 
-  Hashtbl.add directive_table "show"
-     (Directive_generic (dir_show std_out));
-
   ()
diff --git a/toplevel/toploop.ml b/toplevel/toploop.ml
index 83b8224371..a7311d7b41 100644
--- a/toplevel/toploop.ml
+++ b/toplevel/toploop.ml
@@ -28,21 +28,21 @@ type directive_fun =
    | Directive_int of (int -> unit)
    | Directive_ident of (Longident.t -> unit)
    | Directive_bool of (bool -> unit)
-   | Directive_generic of (Parsetree.directive_argument list -> unit)
 
 (* The table of toplevel value bindings and its accessors *)
 
-let toplevel_value_bindings =
-  (Hashtbl.create 37 : (string, Obj.t) Hashtbl.t)
+module StringMap = Map.Make(String)
+
+let toplevel_value_bindings : Obj.t StringMap.t ref = ref StringMap.empty
 
 let getvalue name =
   try
-    Hashtbl.find toplevel_value_bindings name
+    StringMap.find name !toplevel_value_bindings
   with Not_found ->
     fatal_error (name ^ " unbound at toplevel")
 
 let setvalue name v =
-  Hashtbl.replace toplevel_value_bindings name v
+  toplevel_value_bindings := StringMap.add name v !toplevel_value_bindings
 
 (* Return the value referred to by a path *)
 
@@ -53,7 +53,7 @@ let rec eval_path = function
       else begin
         let name = Translmod.toplevel_name id in
         try
-          Hashtbl.find toplevel_value_bindings name
+          StringMap.find name !toplevel_value_bindings
         with Not_found ->
           raise (Symtable.Error(Symtable.Undefined_global name))
       end
@@ -83,6 +83,7 @@ let print_out_value = Oprint.out_value
 let print_out_type = Oprint.out_type
 let print_out_class_type = Oprint.out_class_type
 let print_out_module_type = Oprint.out_module_type
+let print_out_type_extension = Oprint.out_type_extension
 let print_out_sig_item = Oprint.out_sig_item
 let print_out_signature = Oprint.out_signature
 let print_out_phrase = Oprint.out_phrase
@@ -150,6 +151,7 @@ let load_lambda ppf lam =
   Symtable.patch_object code reloc;
   Symtable.check_global_initialized reloc;
   Symtable.update_global_table();
+  let initial_bindings = !toplevel_value_bindings in
   try
     may_trace := true;
     let retval = (Meta.reify_bytecode code code_size) () in
@@ -165,6 +167,7 @@ let load_lambda ppf lam =
       Meta.static_release_bytecode code code_size;
       Meta.static_free code;
     end;
+    toplevel_value_bindings := initial_bindings; (* PR#6211 *)
     Symtable.restore_state initial_symtable;
     Exception x
 
@@ -245,20 +248,27 @@ let execute_phrase print_outcome ppf phr =
         toplevel_env := oldenv; raise x
       end
   | Ptop_dir(dir_name, dir_arg) ->
-      try
-        match (Hashtbl.find directive_table dir_name, dir_arg) with
-        | (Directive_none f, []) -> f (); true
-        | (Directive_string f, [Pdir_string s]) -> f s; true
-        | (Directive_int f, [Pdir_int n]) -> f n; true
-        | (Directive_ident f, [Pdir_ident lid]) -> f lid; true
-        | (Directive_bool f, [Pdir_bool b]) -> f b; true
-        | (Directive_generic f, l) -> f l; true
-        | (_, _) ->
-            fprintf ppf "Wrong type of argument for directive `%s'.@." dir_name;
-            false
-      with Not_found ->
-        fprintf ppf "Unknown directive `%s'.@." dir_name;
-        false
+      let d =
+        try Some (Hashtbl.find directive_table dir_name)
+        with Not_found -> None
+      in
+      begin match d with
+      | None ->
+          fprintf ppf "Unknown directive `%s'.@." dir_name;
+          false
+      | Some d ->
+          match d, dir_arg with
+          | Directive_none f, Pdir_none -> f (); true
+          | Directive_string f, Pdir_string s -> f s; true
+          | Directive_int f, Pdir_int n -> f n; true
+          | Directive_ident f, Pdir_ident lid -> f lid; true
+          | Directive_bool f, Pdir_bool b -> f b; true
+          | _ ->
+              fprintf ppf "Wrong type of argument for directive `%s'.@."
+                dir_name;
+              false
+      end
+
 
 (* Temporary assignment to a reference *)
 
@@ -281,7 +291,7 @@ let phrase ppf phr =
   let phr =
     match phr with
     | Ptop_def str ->
-        Ptop_def (Pparse.apply_rewriters ast_impl_magic_number str)
+        Ptop_def (Pparse.apply_rewriters ~tool_name:"ocaml" ast_impl_magic_number str)
     | phr -> phr
   in
   if !Clflags.dump_parsetree then Printast.top_phrase ppf phr;
@@ -341,7 +351,7 @@ let read_input_default prompt buffer len =
     while true do
       if !i >= len then raise Exit;
       let c = input_char Pervasives.stdin in
-      buffer.[!i] <- c;
+      Bytes.set buffer !i c;
       incr i;
       if c = '\n' then raise Exit;
     done;
@@ -382,8 +392,12 @@ let _ =
   let crc_intfs = Symtable.init_toplevel() in
   Compmisc.init_path false;
   List.iter
-    (fun (name, crc) ->
-      Consistbl.set Env.crc_units name crc Sys.executable_name)
+    (fun (name, crco) ->
+      Env.imported_units := name :: !Env.imported_units;
+      match crco with
+        None -> ()
+      | Some crc->
+          Consistbl.set Env.crc_units name crc Sys.executable_name)
     crc_intfs
 
 let load_ocamlinit ppf =
diff --git a/toplevel/toploop.mli b/toplevel/toploop.mli
index b364a088e7..5f0b86e261 100644
--- a/toplevel/toploop.mli
+++ b/toplevel/toploop.mli
@@ -39,7 +39,6 @@ type directive_fun =
    | Directive_int of (int -> unit)
    | Directive_ident of (Longident.t -> unit)
    | Directive_bool of (bool -> unit)
-   | Directive_generic of (Parsetree.directive_argument list -> unit)
 
 val directive_table : (string, directive_fun) Hashtbl.t
         (* Table of known directives, with their execution function *)
@@ -93,6 +92,8 @@ val print_out_class_type :
   (formatter -> Outcometree.out_class_type -> unit) ref
 val print_out_module_type :
   (formatter -> Outcometree.out_module_type -> unit) ref
+val print_out_type_extension :
+  (formatter -> Outcometree.out_type_extension -> unit) ref
 val print_out_sig_item :
   (formatter -> Outcometree.out_sig_item -> unit) ref
 val print_out_signature :
@@ -102,7 +103,7 @@ val print_out_phrase :
 
 (* Hooks for external line editor *)
 
-val read_interactive_input : (string -> string -> int -> int * bool) ref
+val read_interactive_input : (string -> bytes -> int -> int * bool) ref
 
 (* Hooks for initialization *)
 
diff --git a/toplevel/topmain.ml b/toplevel/topmain.ml
index 0f3ac66f9d..045be0b75c 100644
--- a/toplevel/topmain.ml
+++ b/toplevel/topmain.ml
@@ -67,20 +67,23 @@ module Options = Main_args.Make_bytetop_options (struct
   let _init s = init_file := Some s
   let _noinit = set noinit
   let _labels = clear classic
+  let _no_alias_deps = set transparent_modules
   let _no_app_funct = clear applicative_functors
   let _noassert = set noassert
   let _nolabels = set classic
   let _noprompt = set noprompt
   let _nopromptcont = set nopromptcont
   let _nostdlib = set no_std_include
+  let _open s = open_modules := s :: !open_modules
   let _ppx s = first_ppx := s :: !first_ppx
   let _principal = set principal
   let _rectypes = set recursive_types
+  let _safe_string = clear unsafe_string
   let _short_paths = clear real_paths
   let _stdin () = file_argument ""
   let _strict_sequence = set strict_sequence
-  let _trans_mod = set transparent_modules
   let _unsafe = set fast
+  let _unsafe_string = set unsafe_string
   let _version () = print_version ()
   let _vnum () = print_version_num ()
   let _w s = Warnings.parse_options false s
diff --git a/typing/btype.ml b/typing/btype.ml
index 730aa7c72e..6d1d8cdcd2 100644
--- a/typing/btype.ml
+++ b/typing/btype.ml
@@ -241,7 +241,7 @@ type type_iterators =
     it_signature_item: type_iterators -> signature_item -> unit;
     it_value_description: type_iterators -> value_description -> unit;
     it_type_declaration: type_iterators -> type_declaration -> unit;
-    it_exception_declaration: type_iterators -> exception_declaration -> unit;
+    it_extension_constructor: type_iterators -> extension_constructor -> unit;
     it_module_declaration: type_iterators -> module_declaration -> unit;
     it_modtype_declaration: type_iterators -> modtype_declaration -> unit;
     it_class_declaration: type_iterators -> class_declaration -> unit;
@@ -253,20 +253,28 @@ type type_iterators =
     it_type_expr: type_iterators -> type_expr -> unit;
     it_path: Path.t -> unit; }
 
+let iter_type_expr_cstr_args f = function
+  | Cstr_tuple tl -> List.iter f tl
+  | Cstr_record (_, lbls) -> List.iter (fun d -> f d.ld_type) lbls
+
+let map_type_expr_cstr_args f = function
+  | Cstr_tuple tl -> Cstr_tuple (List.map f tl)
+  | Cstr_record (r, lbls) ->
+      Cstr_record (r, List.map (fun d -> {d with ld_type=f d.ld_type}) lbls)
+
 let iter_type_expr_kind f = function
   | Type_abstract -> ()
   | Type_variant cstrs ->
       List.iter
         (fun cd ->
-           begin match cd.cd_args with
-           | Cstr_tuple tl -> List.iter f tl
-           | Cstr_record (_, lbls) -> List.iter (fun d -> f d.ld_type) lbls
-           end;
+           iter_type_expr_cstr_args f cd.cd_args;
            Misc.may f cd.cd_res
         )
         cstrs
   | Type_record(lbls, _) ->
       List.iter (fun d -> f d.ld_type) lbls
+  | Type_open ->
+      ()
 
 
 let type_iterators =
@@ -275,7 +283,7 @@ let type_iterators =
   and it_signature_item it = function
       Sig_value (_, vd)     -> it.it_value_description it vd
     | Sig_type (_, td, _)   -> it.it_type_declaration it td
-    | Sig_exception (_, ed) -> it.it_exception_declaration it ed
+    | Sig_typext (_, td, _) -> it.it_extension_constructor it td
     | Sig_module (_, md, _) -> it.it_module_declaration it md
     | Sig_modtype (_, mtd)  -> it.it_modtype_declaration it mtd
     | Sig_class (_, cd, _)  -> it.it_class_declaration it cd
@@ -286,11 +294,11 @@ let type_iterators =
     List.iter (it.it_type_expr it) td.type_params;
     may (it.it_type_expr it) td.type_manifest;
     it.it_type_kind it td.type_kind
-  and it_exception_declaration it ed =
-    match ed.exn_args with
-    | Cstr_tuple tl -> List.iter (it.it_type_expr it) tl
-    | Cstr_record (_, lbls) ->
-        List.iter (fun d -> it.it_type_expr it d.ld_type) lbls
+  and it_extension_constructor it td =
+    it.it_path td.ext_type_path;
+    List.iter (it.it_type_expr it) td.ext_type_params;
+    iter_type_expr_cstr_args (it.it_type_expr it) td.ext_args;
+    may (it.it_type_expr it) td.ext_ret_type
   and it_module_declaration it md =
     it.it_module_type it md.md_type
   and it_modtype_declaration it mtd =
@@ -342,7 +350,7 @@ let type_iterators =
   { it_path; it_type_expr = it_do_type_expr; it_do_type_expr;
     it_type_kind; it_class_type; it_module_type;
     it_signature; it_class_type_declaration; it_class_declaration;
-    it_modtype_declaration; it_module_declaration; it_exception_declaration;
+    it_modtype_declaration; it_module_declaration; it_extension_constructor;
     it_type_declaration; it_value_description; it_signature_item; }
 
 let copy_row f fixed row keep more =
@@ -470,6 +478,11 @@ let unmark_iterators =
 let unmark_type_decl decl =
   unmark_iterators.it_type_declaration unmark_iterators decl
 
+let unmark_extension_constructor ext =
+  List.iter unmark_type ext.ext_type_params;
+  iter_type_expr_cstr_args unmark_type ext.ext_args;
+  Misc.may unmark_type ext.ext_ret_type
+
 let unmark_class_signature sign =
   unmark_type sign.csig_self;
   Vars.iter (fun l (m, v, t) -> unmark_type t) sign.csig_vars
diff --git a/typing/btype.mli b/typing/btype.mli
index 35bc552a5d..bf7f9558a8 100644
--- a/typing/btype.mli
+++ b/typing/btype.mli
@@ -95,7 +95,7 @@ type type_iterators =
     it_signature_item: type_iterators -> signature_item -> unit;
     it_value_description: type_iterators -> value_description -> unit;
     it_type_declaration: type_iterators -> type_declaration -> unit;
-    it_exception_declaration: type_iterators -> exception_declaration -> unit;
+    it_extension_constructor: type_iterators -> extension_constructor -> unit;
     it_module_declaration: type_iterators -> module_declaration -> unit;
     it_modtype_declaration: type_iterators -> modtype_declaration -> unit;
     it_class_declaration: type_iterators -> class_declaration -> unit;
@@ -139,6 +139,7 @@ val mark_type_params: type_expr -> unit
         (* Mark the sons of a type node *)
 val unmark_type: type_expr -> unit
 val unmark_type_decl: type_declaration -> unit
+val unmark_extension_constructor: extension_constructor -> unit
 val unmark_class_type: class_type -> unit
 val unmark_class_signature: class_signature -> unit
         (* Remove marks from a type *)
@@ -200,3 +201,7 @@ val log_type: type_expr -> unit
 val print_raw: (Format.formatter -> type_expr -> unit) ref
 
 val iter_type_expr_kind: (type_expr -> unit) -> (type_kind -> unit)
+val iter_type_expr_cstr_args: (type_expr -> unit) ->
+  (constructor_arguments -> unit)
+val map_type_expr_cstr_args: (type_expr -> type_expr) ->
+  (constructor_arguments -> constructor_arguments)
diff --git a/typing/cmi_format.ml b/typing/cmi_format.ml
index e5a8399fac..6f421fdcff 100644
--- a/typing/cmi_format.ml
+++ b/typing/cmi_format.ml
@@ -22,7 +22,7 @@ exception Error of error
 type cmi_infos = {
     cmi_name : string;
     cmi_sign : Types.signature_item list;
-    cmi_crcs : (string * Digest.t) list;
+    cmi_crcs : (string * Digest.t option) list;
     cmi_flags : pers_flags list;
 }
 
@@ -40,7 +40,9 @@ let input_cmi ic =
 let read_cmi filename =
   let ic = open_in_bin filename in
   try
-    let buffer = Misc.input_bytes ic (String.length Config.cmi_magic_number) in
+    let buffer =
+      really_input_string ic (String.length Config.cmi_magic_number)
+    in
     if buffer <> Config.cmi_magic_number then begin
       close_in ic;
       let pre_len = String.length Config.cmi_magic_number - 3 in
@@ -70,7 +72,7 @@ let output_cmi filename oc cmi =
   output_value oc (cmi.cmi_name, cmi.cmi_sign);
   flush oc;
   let crc = Digest.file filename in
-  let crcs = (cmi.cmi_name, crc) :: cmi.cmi_crcs in
+  let crcs = (cmi.cmi_name, Some crc) :: cmi.cmi_crcs in
   output_value oc crcs;
   output_value oc cmi.cmi_flags;
   crc
diff --git a/typing/cmi_format.mli b/typing/cmi_format.mli
index 2d6fdec6bb..32cec451fb 100644
--- a/typing/cmi_format.mli
+++ b/typing/cmi_format.mli
@@ -15,7 +15,7 @@ type pers_flags = Rectypes
 type cmi_infos = {
     cmi_name : string;
     cmi_sign : Types.signature_item list;
-    cmi_crcs : (string * Digest.t) list;
+    cmi_crcs : (string * Digest.t option) list;
     cmi_flags : pers_flags list;
 }
 
diff --git a/typing/cmt_format.ml b/typing/cmt_format.ml
index 29751de8f7..6cecb1b691 100644
--- a/typing/cmt_format.ml
+++ b/typing/cmt_format.ml
@@ -23,9 +23,7 @@ open Typedtree
 
 let read_magic_number ic =
   let len_magic_number = String.length Config.cmt_magic_number in
-  let magic_number = String.create len_magic_number in
-  really_input ic magic_number 0 len_magic_number;
-  magic_number
+  really_input_string ic len_magic_number
 
 type binary_annots =
   | Packed of Types.signature * string list
@@ -56,7 +54,7 @@ type cmt_infos = {
   cmt_loadpath : string list;
   cmt_source_digest : Digest.t option;
   cmt_initial_env : Env.t;
-  cmt_imports : (string * Digest.t) list;
+  cmt_imports : (string * Digest.t option) list;
   cmt_interface_digest : Digest.t option;
   cmt_use_summaries : bool;
 }
@@ -203,7 +201,7 @@ let record_value_dependency vd1 vd2 =
 
 let save_cmt filename modname binary_annots sourcefile initial_env sg =
   if !Clflags.binary_annotations && not !Clflags.print_types then begin
-    let imports = Env.imported_units () in
+    let imports = Env.imports () in
     let oc = open_out_bin filename in
     let this_crc =
       match sg with
diff --git a/typing/cmt_format.mli b/typing/cmt_format.mli
index ba264a314d..48fbc639e8 100644
--- a/typing/cmt_format.mli
+++ b/typing/cmt_format.mli
@@ -57,7 +57,7 @@ type cmt_infos = {
   cmt_loadpath : string list;
   cmt_source_digest : string option;
   cmt_initial_env : Env.t;
-  cmt_imports : (string * Digest.t) list;
+  cmt_imports : (string * Digest.t option) list;
   cmt_interface_digest : Digest.t option;
   cmt_use_summaries : bool;
 }
diff --git a/typing/ctype.ml b/typing/ctype.ml
index 4989aa7ced..30b9ac3361 100644
--- a/typing/ctype.ml
+++ b/typing/ctype.ml
@@ -217,23 +217,38 @@ type unification_mode =
 
 let umode = ref Expression
 let generate_equations = ref false
+let assume_injective = ref false
 
-let set_mode mode ?(generate = (mode = Pattern)) f =
+let set_mode_expression f =
+  let old_unification_mode = !umode in
+  try
+    umode := Expression;
+    let ret = f () in
+    umode := old_unification_mode;
+    ret
+  with e ->
+    umode := old_unification_mode;
+    raise e
+
+let set_mode_pattern ~generate ~injective f =
   let old_unification_mode = !umode
-  and old_gen = !generate_equations in
+  and old_gen = !generate_equations
+  and old_inj = !assume_injective in
   try
-    umode := mode;
+    umode := Pattern;
     generate_equations := generate;
+    assume_injective := injective;
     let ret = f () in
     umode := old_unification_mode;
     generate_equations := old_gen;
+    assume_injective := old_inj;
     ret
   with e ->
     umode := old_unification_mode;
     generate_equations := old_gen;
+    assume_injective := old_inj;
     raise e
 
-
 (*** Checks for type definitions ***)
 
 let in_current_module = function
@@ -242,12 +257,12 @@ let in_current_module = function
 
 let in_pervasives p =
   in_current_module p &&
-  try ignore (Env.find_type p Env.initial); true
+  try ignore (Env.find_type p Env.initial_safe_string); true
   with Not_found -> false
 
 let is_datatype decl=
   match decl.type_kind with
-    Type_record _ | Type_variant _ -> true
+    Type_record _ | Type_variant _ | Type_open -> true
   | Type_abstract -> false
 
 
@@ -555,6 +570,7 @@ let closed_type_decl decl =
           v
     | Type_record(r, rep) ->
         List.iter (fun l -> closed_type l.ld_type) r
+    | Type_open -> ()
     end;
     begin match decl.type_manifest with
       None    -> ()
@@ -566,6 +582,19 @@ let closed_type_decl decl =
     unmark_type_decl decl;
     Some ty
 
+let closed_extension_constructor ext =
+  try
+    List.iter mark_type ext.ext_type_params;
+    begin match ext.ext_ret_type with
+    | Some _ -> ()
+    | None -> iter_type_expr_cstr_args closed_type ext.ext_args
+    end;
+    unmark_extension_constructor ext;
+    None
+  with Non_closed (ty, _) ->
+    unmark_extension_constructor ext;
+    Some ty
+
 type closed_class_failure =
     CC_Method of type_expr * bool * string * type_expr
   | CC_Value of type_expr * bool * string * type_expr
@@ -1163,6 +1192,7 @@ let instance_parameterized_type_2 sch_args sch_lst sch =
 
 let map_kind f = function
   | Type_abstract -> Type_abstract
+  | Type_open -> Type_open
   | Type_variant cl ->
       Type_variant (
         List.map
@@ -1680,7 +1710,9 @@ let occur env ty0 ty =
 let occur_in env ty0 t =
   try occur env ty0 t; false with Unify _ -> true
 
-(* checks that a local constraint is non recursive *)
+(* Check that a local constraint is well-founded *)
+(* PR#6405: not needed since we allow recursion and work on normalized types *)
+(*
 let rec local_non_recursive_abbrev visited env p ty =
   let ty = repr ty in
   if not (List.memq ty !visited) then begin
@@ -1690,19 +1722,14 @@ let rec local_non_recursive_abbrev visited env p ty =
         if Path.same p p' then raise Recursive_abbrev;
         begin try
           local_non_recursive_abbrev visited env p (try_expand_once_opt env ty)
-        with Cannot_expand ->
-          if !Clflags.recursive_types then () else
-          iter_type_expr (local_non_recursive_abbrev visited env p) ty
+        with Cannot_expand -> ()
         end
-    | Tobject _ | Tvariant _ ->
-        ()
-    | _ ->
-        if !Clflags.recursive_types then () else
-        iter_type_expr (local_non_recursive_abbrev visited env p) ty
+    | _ -> ()
   end
 
 let local_non_recursive_abbrev env p =
   local_non_recursive_abbrev (ref []) env p
+*)
 
                    (*****************************)
                    (*  Polymorphic Unification  *)
@@ -2116,10 +2143,6 @@ and mcomp_type_decl type_pairs env p1 p2 tl1 tl2 =
     let decl = Env.find_type p1 env in
     let decl' = Env.find_type p2 env in
     if Path.same p1 p2 then begin
-      (* Format.eprintf "@[%a@ %a@]@."
-        !print_raw (newconstr p1 tl2) !print_raw (newconstr p2 tl2);
-      if non_aliasable p1 decl then Format.eprintf "non_aliasable@."
-      else Format.eprintf "aliasable@."; *)
       let inj =
         try List.map Variance.(mem Inj) (Env.find_type p1 env).type_variance
         with Not_found -> List.map (fun _ -> false) tl1
@@ -2127,19 +2150,21 @@ and mcomp_type_decl type_pairs env p1 p2 tl1 tl2 =
       List.iter2
         (fun i (t1,t2) -> if i then mcomp type_pairs env t1 t2)
         inj (List.combine tl1 tl2)
-    end
-    else match decl.type_kind, decl'.type_kind with
-    | Type_record (lst,r), Type_record (lst',r') when r = r' ->
-        mcomp_list type_pairs env tl1 tl2;
-        mcomp_record_description type_pairs env lst lst'
-    | Type_variant v1, Type_variant v2 ->
-        mcomp_list type_pairs env tl1 tl2;
-        mcomp_variant_description type_pairs env v1 v2
-    | Type_variant _, Type_record _
-    | Type_record _, Type_variant _ -> raise (Unify [])
-    | _ ->
-        if non_aliasable p1 decl && (non_aliasable p2 decl'||is_datatype decl')
-        || is_datatype decl && non_aliasable p2 decl' then raise (Unify [])
+    end else if non_aliasable p1 decl && non_aliasable p2 decl' then raise (Unify [])
+    else
+      match decl.type_kind, decl'.type_kind with
+      | Type_record (lst,r), Type_record (lst',r') when r = r' ->
+          mcomp_list type_pairs env tl1 tl2;
+          mcomp_record_description type_pairs env lst lst'
+      | Type_variant v1, Type_variant v2 ->
+          mcomp_list type_pairs env tl1 tl2;
+          mcomp_variant_description type_pairs env v1 v2
+      | Type_open, Type_open ->
+          mcomp_list type_pairs env tl1 tl2
+      | Type_abstract, Type_abstract -> ()
+      | Type_abstract, _ when not (non_aliasable p1 decl)-> ()
+      | _, Type_abstract when not (non_aliasable p2 decl') -> ()
+      | _ -> raise (Unify [])
   with Not_found -> ()
 
 and mcomp_type_option type_pairs env t t' =
@@ -2427,11 +2452,13 @@ and unify3 env t1 t1' t2 t2' =
       | (Ttuple tl1, Ttuple tl2) ->
           unify_list env tl1 tl2
       | (Tconstr (p1, tl1, _), Tconstr (p2, tl2, _)) when Path.same p1 p2 ->
-          if !umode = Expression || not !generate_equations
-          || in_current_module p1 (* || in_pervasives p1 *)
-          || List.exists (expands_to_datatype !env) [t1'; t1; t2]
-            (*try is_datatype (Env.find_type p1 !env) with Not_found -> false*)
-          then
+          if !umode = Expression || not !generate_equations then
+            unify_list env tl1 tl2
+          else if !assume_injective then
+            set_mode_pattern ~generate:true ~injective:false
+                             (fun () -> unify_list env tl1 tl2)
+          else if in_current_module p1 (* || in_pervasives p1 *)
+                  || List.exists (expands_to_datatype !env) [t1'; t1; t2] then
             unify_list env tl1 tl2
           else
             let inj =
@@ -2442,7 +2469,7 @@ and unify3 env t1 t1' t2 t2' =
             List.iter2
               (fun i (t1, t2) ->
                 if i then unify env t1 t2 else
-                set_mode Pattern ~generate:false
+                set_mode_pattern ~generate:false ~injective:false
                   begin fun () ->
                     let snap = snapshot () in
                     try unify env t1 t2 with Unify _ ->
@@ -2462,12 +2489,12 @@ and unify3 env t1 t1' t2 t2' =
       | (Tconstr ((Path.Pident p) as path,[],_), _)
         when is_newtype !env path && !generate_equations ->
           reify env t2';
-          local_non_recursive_abbrev !env (Path.Pident p) t2';
+          (* local_non_recursive_abbrev !env (Path.Pident p) t2'; *)
           add_gadt_equation env p t2'
       | (_, Tconstr ((Path.Pident p) as path,[],_))
         when is_newtype !env path && !generate_equations ->
           reify env t1' ;
-          local_non_recursive_abbrev !env (Path.Pident p) t1';
+          (* local_non_recursive_abbrev !env (Path.Pident p) t1'; *)
           add_gadt_equation env p t1'
       | (Tconstr (_,_,_), _) | (_, Tconstr (_,_,_)) when !umode = Pattern ->
           reify env t1';
@@ -2749,7 +2776,7 @@ let unify_gadt ~newtype_level:lev (env:Env.t ref) ty1 ty2 =
   try
     univar_pairs := [];
     newtype_level := Some lev;
-    set_mode Pattern (fun () -> unify env ty1 ty2);
+    set_mode_pattern ~generate:true ~injective:true (fun () -> unify env ty1 ty2);
     newtype_level := None;
     TypePairs.clear unify_eq_set;
   with e ->
@@ -4337,6 +4364,42 @@ let nondep_type_decl env mid id is_covariant decl =
     clear_hash ();
     raise Not_found
 
+(* Preserve sharing inside extension constructors. *)
+let nondep_extension_constructor env mid ext =
+  try
+    let type_path, type_params =
+      if Path.isfree mid ext.ext_type_path then
+        begin
+          let ty =
+            newgenty (Tconstr(ext.ext_type_path, ext.ext_type_params, ref Mnil))
+          in
+          let ty' = nondep_type_rec env mid ty in
+            match (repr ty').desc with
+                Tconstr(p, tl, _) -> p, tl
+              | _ -> raise Not_found
+        end
+      else
+        let type_params =
+          List.map (nondep_type_rec env mid) ext.ext_type_params
+        in
+          ext.ext_type_path, type_params
+    in
+    let args = map_type_expr_cstr_args (nondep_type_rec env mid) ext.ext_args in
+    let ret_type = may_map (nondep_type_rec env mid) ext.ext_ret_type in
+      clear_hash ();
+      { ext_type_path = type_path;
+        ext_type_params = type_params;
+        ext_args = args;
+        ext_ret_type = ret_type;
+        ext_private = ext.ext_private;
+        ext_attributes = ext.ext_attributes;
+        ext_loc = ext.ext_loc;
+      }
+  with Not_found ->
+    clear_hash ();
+    raise Not_found
+
+
 (* Preserve sharing inside class types. *)
 let nondep_class_signature env id sign =
   { csig_self = nondep_type_rec env id sign.csig_self;
diff --git a/typing/ctype.mli b/typing/ctype.mli
index 2af24c3681..b807fbd098 100644
--- a/typing/ctype.mli
+++ b/typing/ctype.mli
@@ -228,6 +228,10 @@ val nondep_type_decl:
         Env.t -> Ident.t -> Ident.t -> bool -> type_declaration ->
         type_declaration
         (* Same for type declarations. *)
+val nondep_extension_constructor:
+        Env.t -> Ident.t -> extension_constructor ->
+        extension_constructor
+          (* Same for extension constructor *)
 val nondep_class_declaration:
         Env.t -> Ident.t -> class_declaration -> class_declaration
         (* Same for class declarations. *)
@@ -245,6 +249,7 @@ val closed_schema: type_expr -> bool
 val free_variables: ?env:Env.t -> type_expr -> type_expr list
         (* If env present, then check for incomplete definitions too *)
 val closed_type_decl: type_declaration -> type_expr option
+val closed_extension_constructor: extension_constructor -> type_expr option
 type closed_class_failure =
     CC_Method of type_expr * bool * string * type_expr
   | CC_Value of type_expr * bool * string * type_expr
diff --git a/typing/datarepr.ml b/typing/datarepr.ml
index efc1fb20a2..ff6117bf41 100644
--- a/typing/datarepr.ml
+++ b/typing/datarepr.ml
@@ -164,28 +164,49 @@ let constructor_descrs ty_path decl manifest_decl cstrs =
   let r = describe_constructors 0 0 cstrs in
   r, !tdecls
 
-let exception_descr ?rebind path_exc decl =
-  let type_manifest () = rebind in
+let extension_descr ?rebind path_ext ext =
+  let ty_res =
+    match ext.ext_ret_type with
+        Some type_ret -> type_ret
+      | None -> newgenconstr ext.ext_type_path ext.ext_type_params
+  in
+  (* TODO #5528: merge code below with constructor_descrs *)
+  let tyl =
+    match ext.ext_args with
+    | Cstr_tuple l -> l
+    | Cstr_record (_, l) -> List.map (fun l -> l.ld_type) l
+  in
+  let arg_vars_set, arg_vars = free_vars (newgenty (Ttuple tyl)) in
+  let existentials =
+    match ext.ext_ret_type with
+      | None -> []
+      | Some type_ret ->
+          let res_vars, _ = free_vars type_ret in
+          TypeSet.elements (TypeSet.diff arg_vars_set res_vars)
+  in
   let cstr_args, cstr_inlined, tds =
-    constructor_args path_exc type_manifest []
-      (Record_exception path_exc)
-      decl.exn_args
+    constructor_args path_ext (fun () -> rebind)
+      arg_vars
+      (Record_extension path_ext)
+      ext.ext_args
   in
-  { cstr_name = Path.last path_exc;
-    cstr_res = Predef.type_exn;
-    cstr_existentials = [];
-    cstr_args;
-    cstr_arity = List.length cstr_args;
-    cstr_tag = Cstr_exception (path_exc, decl.exn_loc);
-    cstr_consts = -1;
-    cstr_nonconsts = -1;
-    cstr_private = Public;
-    cstr_normal = -1;
-    cstr_generalized = false;
-    cstr_loc = decl.exn_loc;
-    cstr_attributes = decl.exn_attributes;
-    cstr_inlined;
-  }, tds
+    { cstr_name = Path.last path_ext;
+      cstr_res = ty_res;
+      cstr_existentials = existentials;
+      cstr_args;
+      cstr_arity = List.length cstr_args;
+      cstr_tag = Cstr_extension(path_ext, cstr_args = []);
+      cstr_consts = -1;
+      cstr_nonconsts = -1;
+      cstr_private = ext.ext_private;
+      cstr_normal = -1;
+      cstr_generalized = ext.ext_ret_type <> None;
+      cstr_loc = ext.ext_loc;
+      cstr_attributes = ext.ext_attributes;
+      cstr_inlined;
+    },
+    tds
+
 
 let none = {desc = Ttuple []; level = -1; id = -1}
                                         (* Clearly ill-formed type *)
diff --git a/typing/datarepr.mli b/typing/datarepr.mli
index fd5f07e0bf..6ae98fabaf 100644
--- a/typing/datarepr.mli
+++ b/typing/datarepr.mli
@@ -22,12 +22,11 @@ val constructor_descrs:
   (Ident.t * constructor_description) list *
   (Ident.t * Path.t * type_declaration) list
 
-val exception_descr:
+val extension_descr:
   ?rebind:Path.t ->
-  Path.t -> exception_declaration ->
+  Path.t -> extension_constructor ->
   constructor_description * (Ident.t * Path.t * type_declaration) list
 
-
 val label_descrs:
   type_expr -> label_declaration list ->
     record_representation -> private_flag ->
diff --git a/typing/env.ml b/typing/env.ml
index 7d5959b6d4..448f2a881d 100644
--- a/typing/env.ml
+++ b/typing/env.ml
@@ -106,7 +106,7 @@ type summary =
     Env_empty
   | Env_value of summary * Ident.t * value_description
   | Env_type of summary * Ident.t * type_declaration
-  | Env_exception of summary * Ident.t * exception_declaration
+  | Env_extension of summary * Ident.t * extension_constructor
   | Env_module of summary * Ident.t * module_declaration
   | Env_modtype of summary * Ident.t * modtype_declaration
   | Env_class of summary * Ident.t * class_declaration
@@ -242,13 +242,13 @@ let is_ident = function
 
 let is_local (p, _) = is_ident p
 
-let is_local_exn = function
-  | {cstr_tag = Cstr_exception (p, _)} -> is_ident p
+let is_local_ext = function
+  | {cstr_tag = Cstr_extension(p, _)} -> is_ident p
   | _ -> false
 
 let diff env1 env2 =
   diff_keys is_local env1.values env2.values @
-  diff_keys is_local_exn env1.constrs env2.constrs @
+  diff_keys is_local_ext env1.constrs env2.constrs @
   diff_keys is_local env1.modules env2.modules @
   diff_keys is_local env1.classes env2.classes
 
@@ -286,10 +286,9 @@ type pers_struct =
   { ps_name: string;
     ps_sig: signature;
     ps_comps: module_components;
-    ps_crcs: (string * Digest.t) list;
+    ps_crcs: (string * Digest.t option) list;
     ps_filename: string;
-    ps_flags: pers_flags list;
-    mutable ps_crcs_checked: bool }
+    ps_flags: pers_flags list }
 
 let persistent_structures =
   (Hashtbl.create 17 : (string, pers_struct option) Hashtbl.t)
@@ -297,14 +296,22 @@ let persistent_structures =
 (* Consistency between persistent structures *)
 
 let crc_units = Consistbl.create()
+let imported_units = ref ([] : string list)
+
+let clear_imports () =
+  Consistbl.clear crc_units;
+  imported_units := []
 
 let check_consistency ps =
-  if ps.ps_crcs_checked then () else
   try
     List.iter
-      (fun (name, crc) -> Consistbl.check crc_units name crc ps.ps_filename)
-      ps.ps_crcs;
-    ps.ps_crcs_checked <- true
+      (fun (name, crco) ->
+         match crco with
+            None -> ()
+          | Some crc ->
+              imported_units := name :: !imported_units;
+              Consistbl.check crc_units name crc ps.ps_filename)
+      ps.ps_crcs
   with Consistbl.Inconsistency(name, source, auth) ->
     error (Inconsistent_import(name, auth, source))
 
@@ -325,12 +332,11 @@ let read_pers_struct modname filename =
              ps_sig = sign;
              ps_comps = comps;
              ps_crcs = crcs;
-             ps_crcs_checked = false;
              ps_filename = filename;
              ps_flags = flags } in
   if ps.ps_name <> modname then
     error (Illegal_renaming(modname, ps.ps_name, filename));
-  if not !Clflags.transparent_modules then check_consistency ps;
+  imported_units := name :: !imported_units;
   List.iter
     (function Rectypes ->
       if not !Clflags.recursive_types then
@@ -350,13 +356,13 @@ let find_pers_struct ?(check=true) name =
     | Some None -> raise Not_found
     | Some (Some sg) -> sg
     | None ->
-      let filename =
-        try find_in_path_uncap !load_path (name ^ ".cmi")
-        with Not_found ->
-          Hashtbl.add persistent_structures name None;
-          raise Not_found
-      in
-      read_pers_struct name filename
+        let filename =
+          try find_in_path_uncap !load_path (name ^ ".cmi")
+          with Not_found ->
+            Hashtbl.add persistent_structures name None;
+            raise Not_found
+        in
+        read_pers_struct name filename
   in
   if check then check_consistency ps;
   ps
@@ -364,7 +370,7 @@ let find_pers_struct ?(check=true) name =
 let reset_cache () =
   current_unit := "";
   Hashtbl.clear persistent_structures;
-  Consistbl.clear crc_units;
+  clear_imports ();
   Hashtbl.clear value_declarations;
   Hashtbl.clear type_declarations;
   Hashtbl.clear used_constructors;
@@ -615,7 +621,7 @@ let rec lookup_module_descr lid env =
       end
   | Lapply(l1, l2) ->
       let (p1, desc1) = lookup_module_descr l1 env in
-      let p2 = lookup_module l2 env in
+      let p2 = lookup_module true l2 env in
       let {md_type=mty2} = find_module p2 env in
       begin match EnvLazy.force !components_of_module_maker' desc1 with
         Functor_comps f ->
@@ -625,7 +631,7 @@ let rec lookup_module_descr lid env =
           raise Not_found
       end
 
-and lookup_module lid env : Path.t =
+and lookup_module ~load lid env : Path.t =
   match lid with
     Lident s ->
       begin try
@@ -639,7 +645,11 @@ and lookup_module lid env : Path.t =
         p
       with Not_found ->
         if s = !current_unit then raise Not_found;
-        ignore (find_pers_struct ~check:false s);
+        if !Clflags.transparent_modules && not load then
+          try ignore (find_pers_struct ~check:false s)
+          with Not_found ->
+	    Location.prerr_warning Location.none (Warnings.No_cmi_file s)
+        else ignore (find_pers_struct s);
         Pident(Ident.create_persistent s)
       end
   | Ldot(l, s) ->
@@ -653,7 +663,7 @@ and lookup_module lid env : Path.t =
       end
   | Lapply(l1, l2) ->
       let (p1, desc1) = lookup_module_descr l1 env in
-      let p2 = lookup_module l2 env in
+      let p2 = lookup_module true l2 env in
       let {md_type=mty2} = find_module p2 env in
       let p = Papply(p1, p2) in
       begin match EnvLazy.force !components_of_module_maker' desc1 with
@@ -728,7 +738,7 @@ let has_local_constraints env = env.local_constraints
 
 let cstr_shadow cstr1 cstr2 =
   match cstr1.cstr_tag, cstr2.cstr_tag with
-    Cstr_exception _, Cstr_exception _ -> true
+  | Cstr_extension _, Cstr_extension _ -> true
   | _ -> false
 
 let lbl_shadow lbl1 lbl2 = false
@@ -762,8 +772,9 @@ let mark_constructor_used usage name vd constr =
   try Hashtbl.find used_constructors (name, vd.type_loc, constr) usage
   with Not_found -> ()
 
-let mark_exception_used usage ed constr =
-  try Hashtbl.find used_constructors ("exn", ed.exn_loc, constr) usage
+let mark_extension_used usage ext name =
+  let ty_name = Path.last ext.ext_type_path in
+  try Hashtbl.find used_constructors (ty_name, ext.ext_loc, name) usage
   with Not_found -> ()
 
 let set_value_used_callback name vd callback =
@@ -841,9 +852,11 @@ let lookup_all_constructors lid env =
 
 let mark_constructor usage env name desc =
   match desc.cstr_tag with
-  | Cstr_exception (_, loc) ->
+  | Cstr_extension _ ->
       begin
-        try Hashtbl.find used_constructors ("exn", loc, name) usage
+        let ty_path = ty_path desc.cstr_res in
+        let ty_name = Path.last ty_path in
+        try Hashtbl.find used_constructors (ty_name, desc.cstr_loc, name) usage
         with Not_found -> ()
       end
   | _ ->
@@ -1020,9 +1033,8 @@ let rec scrape_alias env ?path mty =
       begin try
         scrape_alias env (find_module path env).md_type ~path
       with Not_found ->
-        Location.prerr_warning Location.none
-          (Warnings.Deprecated
-             ("module " ^ Path.name path ^ " cannot be accessed"));
+        (*Location.prerr_warning Location.none
+	  (Warnings.No_cmi_file (Path.name path));*)
         mty
       end
   | mty, Some path ->
@@ -1045,7 +1057,7 @@ let constructors_of_type env ty_path decl =
         | _ -> None
       in
       Datarepr.constructor_descrs ty_path decl manifest_decl cstrs
-  | Type_record _ | Type_abstract -> [], []
+  | Type_record _ | Type_abstract | Type_open -> [], []
 
 (* Compute label descriptions *)
 
@@ -1054,10 +1066,10 @@ let labels_of_type ty_path decl =
     Type_record(labels, rep) ->
       let rep =
         match rep with
-        | Record_exception (Pident id) ->
+        | Record_extension (Pident id) ->
             begin match ty_path with
             | Path.Pdot (path, _, pos) ->
-                Record_exception (Path.Pdot (path, Ident.name id, pos))
+                Record_extension (Path.Pdot (path, Ident.name id, pos))
             | Path.Pident _ ->
                 rep
             | Path.Papply _ -> assert false
@@ -1067,7 +1079,7 @@ let labels_of_type ty_path decl =
       Datarepr.label_descrs
         (newgenty (Tconstr(ty_path, decl.type_params, ref Mnil)))
         labels rep decl.type_private
-  | Type_variant _ | Type_abstract -> []
+  | Type_variant _ | Type_abstract | Type_open -> []
 
 (* Given a signature and a root path, prefix all idents in the signature
    by the root path and build the corresponding substitution. *)
@@ -1085,9 +1097,9 @@ let rec prefix_idents root pos sub = function
       let (pl, final_sub) =
         prefix_idents root pos (Subst.add_type id p sub) rem in
       (p::pl, final_sub)
-  | Sig_exception(id, decl) :: rem ->
+  | Sig_typext(id, ext, _) :: rem ->
       let p = Pdot(root, Ident.name id, pos) in
-      let sub = Subst.add_prefixes root (Subst.sub_ids_exn decl) sub in
+      let sub = Subst.add_prefixes root (Subst.sub_ids_ext ext) sub in
       let (pl, final_sub) = prefix_idents root (pos+1) sub rem in
       (p::pl, final_sub)
   | Sig_module(id, mty, _) :: rem ->
@@ -1118,8 +1130,8 @@ let subst_signature sub sg =
           Sig_value (id, Subst.value_description sub decl)
       | Sig_type(id, decl, x) ->
           Sig_type(id, Subst.type_declaration sub decl, x)
-      | Sig_exception(id, decl) ->
-          Sig_exception (id, Subst.exception_declaration sub decl)
+      | Sig_typext(id, ext, es) ->
+          Sig_typext (id, Subst.extension_constructor sub ext, es)
       | Sig_module(id, mty, x) ->
           Sig_module(id, Subst.module_declaration sub mty,x)
       | Sig_modtype(id, decl) ->
@@ -1210,17 +1222,16 @@ and components_of_module_maker (env, sub, path, mty) =
                 c.comp_labels <-
                   add_to_tbl descr.lbl_name (descr, nopos) c.comp_labels)
               labels;
-            env := store_type_infos None id path decl !env !env
-        | Sig_exception(id, decl) ->
-            let decl' = Subst.exception_declaration sub decl in
-            let cstr, tdecls = Datarepr.exception_descr path decl' in
+            env := store_type_infos None id (Pident id) decl !env !env
+        | Sig_typext(id, ext, _) ->
+            let ext' = Subst.extension_constructor sub ext in
+            let descr, tdecls = Datarepr.extension_descr path ext' in
             List.iter
               (fun (id, path, td) ->
                  aux (Sig_type(id, td, Trec_next)) path;
               ) tdecls;
-            let s = Ident.name id in
             c.comp_constrs <-
-              add_to_tbl s (cstr, !pos) c.comp_constrs;
+              add_to_tbl (Ident.name id) (descr, !pos) c.comp_constrs;
             incr pos
         | Sig_module(id, md, _) ->
             let mty = md.md_type in
@@ -1230,13 +1241,13 @@ and components_of_module_maker (env, sub, path, mty) =
             let comps = components_of_module !env sub path mty in
             c.comp_components <-
               Tbl.add (Ident.name id) (comps, !pos) c.comp_components;
-            env := store_module None id path md !env !env;
+            env := store_module None id (Pident id) md !env !env;
             incr pos
         | Sig_modtype(id, decl) ->
             let decl' = Subst.modtype_declaration sub decl in
             c.comp_modtypes <-
               Tbl.add (Ident.name id) (decl', nopos) c.comp_modtypes;
-            env := store_modtype None id path decl !env !env
+            env := store_modtype None id (Pident id) decl !env !env
         | Sig_class(id, decl, _) ->
             let decl' = Subst.class_declaration sub decl in
             c.comp_classes <-
@@ -1371,14 +1382,14 @@ and store_type_infos slot id path info env renv =
                        renv.types;
     summary = Env_type(env.summary, id, info) }
 
-and store_exception ?rebind ~check slot id path decl env renv =
-  let loc = decl.exn_loc in
+and store_extension ?rebind ~check slot id path ext env renv =
+  let loc = ext.ext_loc in
   if check && not loc.Location.loc_ghost &&
-    Warnings.is_active (Warnings.Unused_exception ("", false))
+    Warnings.is_active (Warnings.Unused_extension ("", false, false))
   then begin
-    let ty = "exn" in
-    let c = Ident.name id in
-    let k = (ty, loc, c) in
+    let ty = Path.last ext.ext_type_path in
+    let n = Ident.name id in
+    let k = (ty, loc, n) in
     if not (Hashtbl.mem used_constructors k) then begin
       let used = constructor_usages () in
       Hashtbl.add used_constructors k (add_constructor_usage used);
@@ -1386,17 +1397,18 @@ and store_exception ?rebind ~check slot id path decl env renv =
         (fun () ->
           if not env.in_signature && not used.cu_positive then
             Location.prerr_warning loc
-              (Warnings.Unused_exception
-                 (c, used.cu_pattern)
+              (Warnings.Unused_extension
+                 (n, used.cu_pattern, used.cu_privatize)
               )
         )
     end;
+
   end;
-  let constr, tdecls = Datarepr.exception_descr ?rebind path decl in
+  let constr, tdecls = Datarepr.extension_descr ?rebind path ext in
   let env = store_extra_tdecls slot tdecls env renv in
   { env with
     constrs = EnvTbl.add "constructor" slot id constr env.constrs renv.constrs;
-    summary = Env_exception(env.summary, id, decl) }
+    summary = Env_extension(env.summary, id, ext) }
 
 and store_module slot id path md env renv =
   { env with
@@ -1459,8 +1471,8 @@ let add_value ?check id desc env =
 let add_type ~check id info env =
   store_type ~check None id (Pident id) info env env
 
-and add_exception ~check id decl env =
-  store_exception ~check None id (Pident id) decl env env
+and add_extension ?rebind ~check id ext env =
+  store_extension ?rebind ~check None id (Pident id) ext env env
 
 and add_module_declaration ?arg id md env =
   let path =
@@ -1500,7 +1512,7 @@ let enter store_fun name data env =
 
 let enter_value ?check = enter (store_value ?check)
 and enter_type = enter (store_type ~check:true)
-and enter_exception ?rebind = enter (store_exception ?rebind ~check:true)
+and enter_extension ?rebind = enter (store_extension ?rebind ~check:true)
 and enter_module_declaration ?arg name md env =
   let id = Ident.create name in
   (id, add_module_declaration ?arg id md env)
@@ -1519,7 +1531,7 @@ let add_item comp env =
   match comp with
     Sig_value(id, decl)     -> add_value id decl env
   | Sig_type(id, decl, _)   -> add_type ~check:false id decl env
-  | Sig_exception(id, decl) -> add_exception ~check:false id decl env
+  | Sig_typext(id, ext, _)  -> add_extension ~check:false id ext env
   | Sig_module(id, md, _)  -> add_module_declaration id md env
   | Sig_modtype(id, decl)   -> add_modtype id decl env
   | Sig_class(id, decl, _)  -> add_class id decl env
@@ -1547,8 +1559,8 @@ let open_signature slot root sg env0 =
             store_value slot (Ident.hide id) p decl env env0
         | Sig_type(id, decl, _) ->
             store_type ~check:false slot (Ident.hide id) p decl env env0
-        | Sig_exception(id, decl) ->
-            store_exception ~check:false slot (Ident.hide id) p decl env env0
+        | Sig_typext(id, ext, _) ->
+            store_extension ~check:false slot (Ident.hide id) p ext env env0
         | Sig_module(id, mty, _) ->
             store_module slot (Ident.hide id) p mty env env0
         | Sig_modtype(id, decl) ->
@@ -1607,16 +1619,21 @@ let read_signature modname filename =
 (* Return the CRC of the interface of the given compilation unit *)
 
 let crc_of_unit name =
-  let ps = find_pers_struct ~check:false name in
-  try
-    List.assoc name ps.ps_crcs
-  with Not_found ->
-    assert false
+  let ps = find_pers_struct name in
+  let crco =
+    try
+      List.assoc name ps.ps_crcs
+    with Not_found ->
+      assert false
+  in
+    match crco with
+      None -> assert false
+    | Some crc -> crc
 
 (* Return the list of imported interfaces with their CRCs *)
 
-let imported_units() =
-  Consistbl.extract crc_units
+let imports() =
+  Consistbl.extract !imported_units crc_units
 
 (* Save a signature to a file *)
 
@@ -1645,12 +1662,12 @@ let save_signature_with_imports sg modname filename imports =
       { ps_name = modname;
         ps_sig = sg;
         ps_comps = comps;
-        ps_crcs = (cmi.cmi_name, crc) :: imports;
+        ps_crcs = (cmi.cmi_name, Some crc) :: imports;
         ps_filename = filename;
-        ps_flags = cmi.cmi_flags;
-        ps_crcs_checked = true } in
+        ps_flags = cmi.cmi_flags } in
     Hashtbl.add persistent_structures modname (Some ps);
     Consistbl.set crc_units modname crc filename;
+    imported_units := modname :: !imported_units;
     sg
   with exn ->
     close_out oc;
@@ -1658,7 +1675,7 @@ let save_signature_with_imports sg modname filename imports =
     raise exn
 
 let save_signature sg modname filename =
-  save_signature_with_imports sg modname filename (imported_units())
+  save_signature_with_imports sg modname filename (imports())
 
 (* Folding on environments *)
 
@@ -1749,11 +1766,10 @@ and fold_cltypes f =
 
 
 (* Make the initial environment *)
-
-let initial =
+let (initial_safe_string, initial_unsafe_string) =
   Predef.build_initial_env
     (add_type ~check:false)
-    (add_exception ~check:false)
+    (add_extension ?rebind:None ~check:false)
     empty
 
 (* Return the environment summary *)
diff --git a/typing/env.mli b/typing/env.mli
index 0197a193cd..eae5bc5fad 100644
--- a/typing/env.mli
+++ b/typing/env.mli
@@ -18,7 +18,7 @@ type summary =
     Env_empty
   | Env_value of summary * Ident.t * value_description
   | Env_type of summary * Ident.t * type_declaration
-  | Env_exception of summary * Ident.t * exception_declaration
+  | Env_extension of summary * Ident.t * extension_constructor
   | Env_module of summary * Ident.t * module_declaration
   | Env_modtype of summary * Ident.t * modtype_declaration
   | Env_class of summary * Ident.t * class_declaration
@@ -29,7 +29,8 @@ type summary =
 type t
 
 val empty: t
-val initial: t
+val initial_safe_string: t
+val initial_unsafe_string: t
 val diff: t -> t -> Ident.t list
 
 type type_descriptions =
@@ -88,7 +89,7 @@ val lookup_label: Longident.t -> t -> label_description
 val lookup_all_labels:
   Longident.t -> t -> (label_description * (unit -> unit)) list
 val lookup_type: Longident.t -> t -> Path.t * type_declaration
-val lookup_module: Longident.t -> t -> Path.t
+val lookup_module: load:bool -> Longident.t -> t -> Path.t
 val lookup_modtype: Longident.t -> t -> Path.t * modtype_declaration
 val lookup_class: Longident.t -> t -> Path.t * class_declaration
 val lookup_cltype: Longident.t -> t -> Path.t * class_type_declaration
@@ -103,7 +104,7 @@ exception Recmodule
 val add_value:
     ?check:(string -> Warnings.t) -> Ident.t -> value_description -> t -> t
 val add_type: check:bool -> Ident.t -> type_declaration -> t -> t
-val add_exception: check:bool -> Ident.t -> exception_declaration -> t -> t
+val add_extension: ?rebind:Path.t -> check:bool -> Ident.t -> extension_constructor -> t -> t
 val add_module: ?arg:bool -> Ident.t -> module_type -> t -> t
 val add_module_declaration: ?arg:bool -> Ident.t -> module_declaration -> t -> t
 val add_modtype: Ident.t -> modtype_declaration -> t -> t
@@ -130,8 +131,8 @@ val enter_value:
     ?check:(string -> Warnings.t) ->
     string -> value_description -> t -> Ident.t * t
 val enter_type: string -> type_declaration -> t -> Ident.t * t
-val enter_exception:
-  ?rebind:Path.t -> string -> exception_declaration -> t -> Ident.t * t
+val enter_extension:
+  ?rebind:Path.t -> string -> extension_constructor -> t -> Ident.t * t
 val enter_module: ?arg:bool -> string -> module_type -> t -> Ident.t * t
 val enter_module_declaration:
     ?arg:bool -> string -> module_declaration -> t -> Ident.t * t
@@ -155,7 +156,7 @@ val read_signature: string -> string -> signature
 val save_signature: signature -> string -> string -> signature
         (* Arguments: signature, module name, file name. *)
 val save_signature_with_imports:
-    signature -> string -> string -> (string * Digest.t) list -> signature
+    signature -> string -> string -> (string * Digest.t option) list -> signature
         (* Arguments: signature, module name, file name,
            imported units with their CRCs. *)
 
@@ -165,11 +166,12 @@ val crc_of_unit: string -> Digest.t
 
 (* Return the set of compilation units imported, with their CRC *)
 
-val imported_units: unit -> (string * Digest.t) list
+val imports: unit -> (string * Digest.t option) list
 
 (* Direct access to the table of imported compilation units with their CRC *)
 
 val crc_units: Consistbl.t
+val imported_units: string list ref
 
 (* Summaries -- compact representation of an environment, to be
    exported in debugging information. *)
@@ -206,8 +208,8 @@ val mark_constructor_used:
     constructor_usage -> string -> type_declaration -> string -> unit
 val mark_constructor:
     constructor_usage -> t -> string -> constructor_description -> unit
-val mark_exception_used:
-    constructor_usage -> exception_declaration -> string -> unit
+val mark_extension_used:
+    constructor_usage -> extension_constructor -> string -> unit
 
 val in_signature: t -> t
 
diff --git a/typing/envaux.ml b/typing/envaux.ml
index 04d6d256f7..af86fd25be 100644
--- a/typing/envaux.ml
+++ b/typing/envaux.ml
@@ -47,9 +47,9 @@ let rec env_from_summary sum subst =
           Env.add_type ~check:false id
             (Subst.type_declaration subst desc)
             (env_from_summary s subst)
-      | Env_exception(s, id, desc) ->
-          Env.add_exception ~check:false id
-            (Subst.exception_declaration subst desc)
+      | Env_extension(s, id, desc) ->
+          Env.add_extension ~check:false id
+            (Subst.extension_constructor subst desc)
             (env_from_summary s subst)
       | Env_module(s, id, desc) ->
           Env.add_module_declaration id
diff --git a/typing/includecore.ml b/typing/includecore.ml
index 523cf30c1a..0c5141c05f 100644
--- a/typing/includecore.ml
+++ b/typing/includecore.ml
@@ -148,7 +148,7 @@ let report_type_mismatch0 first second decl ppf err =
         | Record_regular -> "regular"
         | Record_inlined i -> Printf.sprintf"inlined(tag %i)" i
         | Record_float -> "unboxed float"
-        | Record_exception p -> Printf.sprintf "exception %s" (Path.name p)
+        | Record_extension p -> Printf.sprintf "exception %s" (Path.name p)
       in
       pr "Their internal representations differ:@ %s vs %s"
         (repr r1)
@@ -217,7 +217,7 @@ let record_representations r1 r2 =
   | Record_regular, Record_regular -> true
   | Record_inlined i, Record_inlined j -> i = j
   | Record_float, Record_float -> true
-  | Record_exception _, Record_exception _ -> true
+  | Record_extension _, Record_extension _ -> true
   (* allow a different path to support exception rebinding *)
   | _ -> false
 
@@ -246,6 +246,7 @@ let type_declarations ?(equality = false) env name decl1 id decl2 =
             1 labels1 labels2 in
         if err <> [] || record_representations rep1 rep2 then err else
         [Record_representation (rep1, rep2)]
+    | (Type_open, Type_open) -> []
     | (_, _) -> [Kind]
   in
   if err <> [] then err else
@@ -270,26 +271,53 @@ let type_declarations ?(equality = false) env name decl1 id decl2 =
   let abstr =
     decl2.type_private = Private ||
     decl2.type_kind = Type_abstract && decl2.type_manifest = None in
+  let opn = decl2.type_kind = Type_open && decl2.type_manifest = None in
+  let constrained ty = not (Btype.(is_Tvar (repr ty))) in
   if List.for_all2
       (fun ty (v1,v2) ->
         let open Variance in
         let imp a b = not a || b in
         let (co1,cn1) = get_upper v1 and (co2,cn2) = get_upper v2 in
-        imp abstr (imp co1 co2 && imp cn1 cn2) &&
-        (abstr || Btype.(is_Tvar (repr ty)) || co1 = co2 && cn1 = cn2) &&
+        (if abstr then (imp co1 co2 && imp cn1 cn2)
+         else if opn || constrained ty then (co1 = co2 && cn1 = cn2)
+         else true) &&
         let (p1,n1,i1,j1) = get_lower v1 and (p2,n2,i2,j2) = get_lower v2 in
         imp abstr (imp p2 p1 && imp n2 n1 && imp i2 i1 && imp j2 j1))
       decl2.type_params (List.combine decl1.type_variance decl2.type_variance)
   then [] else [Variance]
 
-(* Inclusion between exception declarations *)
+(* Inclusion between extension constructors *)
 
-let exception_declarations env ed1 ed2 =
-  (* note: we use 'Ctype.equal true' now (allow renaming), but
-     since the type are closed, this doesn't matter *)
-  compare_constructor_arguments env (Ident.create "") [] []
-    ed1.exn_args ed2.exn_args
-  = []
+let extension_constructors env id ext1 ext2 =
+  let usage =
+    if ext1.ext_private = Private || ext2.ext_private = Public
+    then Env.Positive else Env.Privatize
+  in
+  Env.mark_extension_used usage ext1 (Ident.name id);
+  let ty1 =
+    Btype.newgenty (Tconstr(ext1.ext_type_path, ext1.ext_type_params, ref Mnil))
+  in
+  let ty2 =
+    Btype.newgenty (Tconstr(ext2.ext_type_path, ext2.ext_type_params, ref Mnil))
+  in
+  if Ctype.equal env true
+       (ty1 :: ext1.ext_type_params)
+       (ty2 :: ext2.ext_type_params)
+  then
+    if compare_constructor_arguments env (Ident.create "")
+        ext1.ext_type_params ext2.ext_type_params
+        ext1.ext_args ext2.ext_args = [] then
+      if match ext1.ext_ret_type, ext2.ext_ret_type with
+          Some r1, Some r2 when not (Ctype.equal env true [r1] [r2]) -> false
+        | Some _, None | None, Some _ -> false
+        | _ -> true
+      then
+        match ext1.ext_private, ext2.ext_private with
+            Private, Public -> false
+          | _, _ -> true
+      else false
+    else false
+  else false
 
 (* Inclusion between class types *)
 let encode_val (mut, ty) rem =
diff --git a/typing/includecore.mli b/typing/includecore.mli
index 75e6c1957b..d98455380c 100644
--- a/typing/includecore.mli
+++ b/typing/includecore.mli
@@ -37,8 +37,8 @@ val type_declarations:
     ?equality:bool ->
       Env.t -> string ->
         type_declaration -> Ident.t -> type_declaration -> type_mismatch list
-val exception_declarations:
-    Env.t -> exception_declaration -> exception_declaration -> bool
+val extension_constructors:
+    Env.t -> Ident.t -> extension_constructor -> extension_constructor -> bool
 (*
 val class_types:
         Env.t -> class_type -> class_type -> bool
diff --git a/typing/includemod.ml b/typing/includemod.ml
index 7f80e3c0f9..57fec56142 100644
--- a/typing/includemod.ml
+++ b/typing/includemod.ml
@@ -22,8 +22,8 @@ type symptom =
   | Value_descriptions of Ident.t * value_description * value_description
   | Type_declarations of Ident.t * type_declaration
         * type_declaration * Includecore.type_mismatch list
-  | Exception_declarations of
-      Ident.t * exception_declaration * exception_declaration
+  | Extension_constructors of
+      Ident.t * extension_constructor * extension_constructor
   | Module_types of module_type * module_type
   | Modtype_infos of Ident.t * modtype_declaration * modtype_declaration
   | Modtype_permutation
@@ -68,14 +68,13 @@ let type_declarations env cxt subst id decl1 decl2 =
   if err <> [] then
     raise(Error[cxt, env, Type_declarations(id, decl1, decl2, err)])
 
-(* Inclusion between exception declarations *)
+(* Inclusion between extension constructors *)
 
-let exception_declarations env cxt subst id decl1 decl2 =
-  Env.mark_exception_used Env.Positive decl1 (Ident.name id);
-  let decl2 = Subst.exception_declaration subst decl2 in
-  if Includecore.exception_declarations env decl1 decl2
+let extension_constructors env cxt subst id ext1 ext2 =
+  let ext2 = Subst.extension_constructor subst ext2 in
+  if Includecore.extension_constructors env id ext1 ext2
   then ()
-  else raise(Error[cxt, env, Exception_declarations(id, decl1, decl2)])
+  else raise(Error[cxt, env, Extension_constructors(id, ext1, ext2)])
 
 (* Inclusion between class declarations *)
 
@@ -124,7 +123,7 @@ let rec normalize_module_path env cxt path =
 type field_desc =
     Field_value of string
   | Field_type of string
-  | Field_exception of string
+  | Field_typext of string
   | Field_module of string
   | Field_modtype of string
   | Field_class of string
@@ -133,7 +132,7 @@ type field_desc =
 let kind_of_field_desc = function
   | Field_value _ -> "value"
   | Field_type _ -> "type"
-  | Field_exception _ -> "exception"
+  | Field_typext _ -> "extension constructor"
   | Field_module _ -> "module"
   | Field_modtype _ -> "module type"
   | Field_class _ -> "class"
@@ -142,7 +141,7 @@ let kind_of_field_desc = function
 let item_ident_name = function
     Sig_value(id, d) -> (id, d.val_loc, Field_value(Ident.name id))
   | Sig_type(id, d, _) -> (id, d.type_loc, Field_type(Ident.name id))
-  | Sig_exception(id, d) -> (id, d.exn_loc, Field_exception(Ident.name id))
+  | Sig_typext(id, d, _) -> (id, d.ext_loc, Field_typext(Ident.name id))
   | Sig_module(id, d, _) -> (id, d.md_loc, Field_module(Ident.name id))
   | Sig_modtype(id, d) -> (id, d.mtd_loc, Field_modtype(Ident.name id))
   | Sig_class(id, d, _) -> (id, d.cty_loc, Field_class(Ident.name id))
@@ -154,7 +153,7 @@ let is_runtime_component = function
   | Sig_modtype(_,_)
   | Sig_class_type(_,_,_) -> false
   | Sig_value(_,_)
-  | Sig_exception(_,_)
+  | Sig_typext(_,_,_)
   | Sig_module(_,_,_)
   | Sig_class(_, _,_) -> true
 
@@ -331,11 +330,11 @@ and signatures env cxt subst sig1 sig2 =
                 Subst.add_module id2 (Pident id1) subst
             | Sig_modtype _ ->
                 Subst.add_modtype id2 (Mty_ident (Pident id1)) subst
-            | Sig_exception (id2', decl2) ->
+            | Sig_typext (id2', decl2, _) ->
                 begin match item1 with
-                | Sig_exception (id1', decl1) ->
-                    let ids1 = Subst.sub_ids_exn decl1 in
-                    let ids2 = Subst.sub_ids_exn decl2 in
+                | Sig_typext (id1', decl1, _) ->
+                    let ids1 = Subst.sub_ids_ext decl1 in
+                    let ids2 = Subst.sub_ids_ext decl2 in
                     equate_subtypes ids1 ids2 subst
                 | _ -> assert false
                 end
@@ -368,9 +367,9 @@ and signature_components env cxt subst = function
   | (Sig_type(id1, tydecl1, _), Sig_type(id2, tydecl2, _), pos) :: rem ->
       type_declarations env cxt subst id1 tydecl1 tydecl2;
       signature_components env cxt subst rem
-  | (Sig_exception(id1, excdecl1), Sig_exception(id2, excdecl2), pos)
+  | (Sig_typext(id1, ext1, _), Sig_typext(id2, ext2, _), pos)
     :: rem ->
-      exception_declarations env cxt subst id1 excdecl1 excdecl2;
+      extension_constructors env cxt subst id1 ext1 ext2;
       (pos, Tcoerce_none) :: signature_components env cxt subst rem
   | (Sig_module(id1, mty1, _), Sig_module(id2, mty2, _), pos) :: rem ->
       let cc =
@@ -428,9 +427,9 @@ let _ = Env.check_modtype_inclusion := check_modtype_inclusion
 (* Check that an implementation of a compilation unit meets its
    interface. *)
 
-let compunit impl_name impl_sig intf_name intf_sig =
+let compunit env impl_name impl_sig intf_name intf_sig =
   try
-    signatures Env.initial [] Subst.identity impl_sig intf_sig
+    signatures env [] Subst.identity impl_sig intf_sig
   with Error reasons ->
     raise(Error(([], Env.empty,Interface_mismatch(impl_name, intf_name))
                 :: reasons))
@@ -474,13 +473,13 @@ let include_err ppf = function
         show_locs (d1.type_loc, d2.type_loc)
         (Includecore.report_type_mismatch
            "the first" "the second" "declaration") errs
-  | Exception_declarations(id, d1, d2) ->
+  | Extension_constructors(id, x1, x2) ->
       fprintf ppf
-       "@[<hv 2>Exception declarations do not match:@ \
+       "@[<hv 2>Extension declarations do not match:@ \
         %a@;<1 -2>is not included in@ %a@]"
-        (exception_declaration id) d1
-        (exception_declaration id) d2;
-      show_locs ppf (d1.exn_loc, d2.exn_loc)
+      (extension_constructor id) x1
+      (extension_constructor id) x2;
+      show_locs ppf (x1.ext_loc, x2.ext_loc)
   | Module_types(mty1, mty2)->
       fprintf ppf
        "@[<hv 2>Modules do not match:@ \
@@ -562,12 +561,12 @@ let include_err ppf (cxt, env, err) =
   Printtyp.wrap_printing_env env (fun () ->
     fprintf ppf "@[<v>%a%a@]" context (List.rev cxt) include_err err)
 
-let buffer = ref ""
+let buffer = ref Bytes.empty
 let is_big obj =
   let size = !Clflags.error_size in
   size > 0 &&
   begin
-    if String.length !buffer < size then buffer := String.create size;
+    if Bytes.length !buffer < size then buffer := Bytes.create size;
     try ignore (Marshal.to_buffer !buffer 0 size obj []); false
     with _ -> true
   end
diff --git a/typing/includemod.mli b/typing/includemod.mli
index 2e00bb0246..7ea48f8619 100644
--- a/typing/includemod.mli
+++ b/typing/includemod.mli
@@ -18,7 +18,8 @@ open Format
 
 val modtypes: Env.t -> module_type -> module_type -> module_coercion
 val signatures: Env.t -> signature -> signature -> module_coercion
-val compunit: string -> signature -> string -> signature -> module_coercion
+val compunit:
+      Env.t -> string -> signature -> string -> signature -> module_coercion
 val type_declarations:
       Env.t -> Ident.t -> type_declaration -> type_declaration -> unit
 
@@ -27,8 +28,8 @@ type symptom =
   | Value_descriptions of Ident.t * value_description * value_description
   | Type_declarations of Ident.t * type_declaration
         * type_declaration * Includecore.type_mismatch list
-  | Exception_declarations of
-      Ident.t * exception_declaration * exception_declaration
+  | Extension_constructors of
+      Ident.t * extension_constructor * extension_constructor
   | Module_types of module_type * module_type
   | Modtype_infos of Ident.t * modtype_declaration * modtype_declaration
   | Modtype_permutation
diff --git a/typing/mtype.ml b/typing/mtype.ml
index bcf13b1681..4e1e0a4f7a 100644
--- a/typing/mtype.ml
+++ b/typing/mtype.ml
@@ -60,7 +60,7 @@ and strengthen_sig env sg p =
               { decl with type_manifest = manif }
       in
       Sig_type(id, newdecl, rs) :: strengthen_sig env rem p
-  | (Sig_exception(id, d) as sigelt) :: rem ->
+  | (Sig_typext(id, ext, es) as sigelt) :: rem ->
       sigelt :: strengthen_sig env rem p
   | Sig_module(id, md, rs) :: rem ->
       let str = strengthen_decl env md (Pdot(p, Ident.name id, nopos)) in
@@ -128,20 +128,9 @@ let nondep_supertype env mid mty =
       | Sig_type(id, d, rs) ->
           Sig_type(id, Ctype.nondep_type_decl env mid id (va = Co) d, rs)
           :: rem'
-      | Sig_exception(id, d) ->
-          let d =
-            {d with
-             exn_args = match d.exn_args with
-             | Cstr_tuple l ->
-                 Cstr_tuple (List.map (Ctype.nondep_type env mid) l)
-             | Cstr_record (id, l) ->
-                 let field l =
-                   {l with ld_type = Ctype.nondep_type env mid l.ld_type}
-                 in
-                 Cstr_record (id, List.map field l)
-            }
-          in
-          Sig_exception(id, d) :: rem'
+      | Sig_typext(id, ext, es) ->
+          Sig_typext(id, Ctype.nondep_extension_constructor env mid ext, es)
+          :: rem'
       | Sig_module(id, md, rs) ->
           Sig_module(id, {md with md_type=nondep_mty env va md.md_type}, rs)
           :: rem'
@@ -219,7 +208,7 @@ and type_paths_sig env p pos sg =
       type_paths_sig (Env.add_module_declaration id md env) p (pos+1) rem
   | Sig_modtype(id, decl) :: rem ->
       type_paths_sig (Env.add_modtype id decl env) p pos rem
-  | (Sig_exception _ | Sig_class _) :: rem ->
+  | (Sig_typext _ | Sig_class _) :: rem ->
       type_paths_sig env p (pos+1) rem
   | (Sig_class_type _) :: rem ->
       type_paths_sig env p pos rem
@@ -244,7 +233,7 @@ and no_code_needed_sig env sg =
       no_code_needed_sig (Env.add_module_declaration id md env) rem
   | (Sig_type _ | Sig_modtype _ | Sig_class_type _) :: rem ->
       no_code_needed_sig env rem
-  | (Sig_exception _ | Sig_class _) :: rem ->
+  | (Sig_typext _ | Sig_class _) :: rem ->
       false
 
 
@@ -267,13 +256,13 @@ and contains_type_item env = function
     Sig_type (_,({type_manifest = None} |
                  {type_kind = Type_abstract; type_private = Private}),_)
   | Sig_modtype _
-  | Sig_exception (_, {exn_args = Cstr_record _}) ->
+  | Sig_typext (_, {ext_args = Cstr_record _}, _) ->
       raise Exit
   | Sig_module (_, {md_type = mty}, _) ->
       contains_type env mty
   | Sig_value _
   | Sig_type _
-  | Sig_exception _
+  | Sig_typext _
   | Sig_class _
   | Sig_class_type _ ->
       ()
diff --git a/typing/oprint.ml b/typing/oprint.ml
index 8084dff06a..3c2d63708e 100644
--- a/typing/oprint.ml
+++ b/typing/oprint.ml
@@ -223,7 +223,8 @@ and print_simple_out_type ppf =
       print_out_type ppf ty;
       pp_print_char ppf ')';
       pp_close_box ppf ()
-  | Otyp_abstract | Otyp_sum _ | Otyp_manifest (_, _) -> ()
+  | Otyp_abstract | Otyp_open
+  | Otyp_sum _ | Otyp_manifest (_, _) -> ()
   | Otyp_record lbls -> print_record_decl ppf lbls
   | Otyp_module (p, n, tyl) ->
       fprintf ppf "@[<1>(module %s" p;
@@ -347,6 +348,7 @@ let out_class_type = ref print_out_class_type
 let out_module_type = ref (fun _ -> failwith "Oprint.out_module_type")
 let out_sig_item = ref (fun _ -> failwith "Oprint.out_sig_item")
 let out_signature = ref (fun _ -> failwith "Oprint.out_signature")
+let out_type_extension = ref (fun _ -> failwith "Oprint.out_type_extension")
 
 let rec print_out_functor ppf =
   function
@@ -369,6 +371,28 @@ and print_out_signature ppf =
   function
     [] -> ()
   | [item] -> !out_sig_item ppf item
+  | Osig_typext(ext, Oext_first) :: items ->
+      (* Gather together the extension constructors *)
+      let rec gather_extensions acc items =
+        match items with
+            Osig_typext(ext, Oext_next) :: items ->
+              gather_extensions
+                ((ext.oext_name, ext.oext_args, ext.oext_ret_type) :: acc)
+                items
+          | _ -> (List.rev acc, items)
+      in
+      let exts, items =
+        gather_extensions
+          [(ext.oext_name, ext.oext_args, ext.oext_ret_type)]
+          items
+      in
+      let te =
+        { otyext_name = ext.oext_type_name;
+          otyext_params = ext.oext_type_params;
+          otyext_constructors = exts;
+          otyext_private = ext.oext_private }
+      in
+        fprintf ppf "%a@ %a" !out_type_extension te print_out_signature items
   | item :: items ->
       fprintf ppf "%a@ %a" !out_sig_item item print_out_signature items
 and print_out_sig_item ppf =
@@ -383,8 +407,11 @@ and print_out_sig_item ppf =
         (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) ->
-      fprintf ppf "@[<2>exception %a@]" print_out_constr (id, tyl,None)
+  | Osig_typext (ext, Oext_exception) ->
+      fprintf ppf "@[<2>exception %a@]"
+        print_out_constr (ext.oext_name, ext.oext_args, ext.oext_ret_type)
+  | Osig_typext (ext, es) ->
+      print_out_extension_constructor ppf ext
   | Osig_modtype (name, Omty_abstract) ->
       fprintf ppf "@[<2>module type %s@]" name
   | Osig_modtype (name, mty) ->
@@ -413,57 +440,63 @@ and print_out_sig_item ppf =
       fprintf ppf "@[<2>%s %a :@ %a%a@]" kwd value_ident name !out_type
         ty pr_prims prims
 
-and print_out_type_decl kwd ppf (name, args, ty, priv, constraints) =
-  let print_constraints ppf params =
+and print_out_type_decl kwd ppf td =
+  let print_constraints ppf =
     List.iter
       (fun (ty1, ty2) ->
          fprintf ppf "@ @[<2>constraint %a =@ %a@]" !out_type ty1
            !out_type ty2)
-      params
+      td.otype_cstrs
   in
   let type_defined ppf =
-    match args with
-      [] -> pp_print_string ppf name
-    | [arg] -> fprintf ppf "@[%a@ %s@]" type_parameter arg name
+    match td.otype_params with
+      [] -> pp_print_string ppf td.otype_name
+    | [param] -> fprintf ppf "@[%a@ %s@]" type_parameter param td.otype_name
     | _ ->
         fprintf ppf "@[(@[%a)@]@ %s@]"
-          (print_list type_parameter (fun ppf -> fprintf ppf ",@ ")) args name
+          (print_list type_parameter (fun ppf -> fprintf ppf ",@ "))
+          td.otype_params
+          td.otype_name
   in
   let print_manifest ppf =
     function
       Otyp_manifest (ty, _) -> fprintf ppf " =@ %a" !out_type ty
     | _ -> ()
   in
-  let print_name_args ppf =
-    fprintf ppf "%s %t%a" kwd type_defined print_manifest ty
+  let print_name_params ppf =
+    fprintf ppf "%s %t%a" kwd type_defined print_manifest td.otype_type
   in
   let ty =
-    match ty with
+    match td.otype_type with
       Otyp_manifest (_, ty) -> ty
-    | _ -> ty
+    | _ -> td.otype_type
   in
   let print_private ppf = function
     Asttypes.Private -> fprintf ppf " private"
-  | Asttypes.Public -> () in
+  | Asttypes.Public -> ()
+  in
   let print_out_tkind ppf = function
   | Otyp_abstract -> ()
   | Otyp_record lbls ->
       fprintf ppf " =%a %a"
-        print_private priv
+        print_private td.otype_private
         print_record_decl lbls
   | Otyp_sum constrs ->
       fprintf ppf " =%a@;<1 2>%a"
-        print_private priv
+        print_private td.otype_private
         (print_list print_out_constr (fun ppf -> fprintf ppf "@ | ")) constrs
+  | Otyp_open ->
+      fprintf ppf " = .."
   | ty ->
       fprintf ppf " =%a@;<1 2>%a"
-        print_private priv
+        print_private td.otype_private
         !out_type ty
   in
-  fprintf ppf "@[<2>@[<hv 2>%t%a@]%a@]"
-    print_name_args
+  fprintf ppf "@[<2>@[<hv 2>%t%a@]%t@]"
+    print_name_params
     print_out_tkind ty
-    print_constraints constraints
+    print_constraints
+
 and print_out_constr ppf (name, tyl,ret_type_opt) =
   match ret_type_opt with
   | None ->
@@ -484,9 +517,58 @@ and print_out_constr ppf (name, tyl,ret_type_opt) =
             tyl print_simple_out_type ret_type
       end
 
+and print_out_extension_constructor ppf ext =
+  let print_extended_type ppf =
+    let print_type_parameter ppf ty =
+      fprintf ppf "%s"
+        (if ty = "_" then ty else "'"^ty)
+    in
+      match ext.oext_type_params with
+        [] -> fprintf ppf "%s" ext.oext_type_name
+      | [ty_param] ->
+        fprintf ppf "@[%a@ %s@]"
+          print_type_parameter
+          ty_param
+          ext.oext_type_name
+      | _ ->
+        fprintf ppf "@[(@[%a)@]@ %s@]"
+          (print_list print_type_parameter (fun ppf -> fprintf ppf ",@ "))
+          ext.oext_type_params
+          ext.oext_type_name
+  in
+  fprintf ppf "@[<hv 2>type %t +=%s@;<1 2>%a@]"
+    print_extended_type
+    (if ext.oext_private = Asttypes.Private then " private" else "")
+    print_out_constr (ext.oext_name, ext.oext_args, ext.oext_ret_type)
+
+and print_out_type_extension ppf te =
+  let print_extended_type ppf =
+    let print_type_parameter ppf ty =
+      fprintf ppf "%s"
+        (if ty = "_" then ty else "'"^ty)
+    in
+    match te.otyext_params with
+      [] -> fprintf ppf "%s" te.otyext_name
+    | [param] ->
+      fprintf ppf "@[%a@ %s@]"
+        print_type_parameter param
+        te.otyext_name
+    | _ ->
+        fprintf ppf "@[(@[%a)@]@ %s@]"
+          (print_list print_type_parameter (fun ppf -> fprintf ppf ",@ "))
+          te.otyext_params
+          te.otyext_name
+  in
+  fprintf ppf "@[<hv 2>type %t +=%s@;<1 2>%a@]"
+    print_extended_type
+    (if te.otyext_private = Asttypes.Private then " private" else "")
+    (print_list print_out_constr (fun ppf -> fprintf ppf "@ | "))
+    te.otyext_constructors
+
 let _ = out_module_type := print_out_module_type
 let _ = out_signature := print_out_signature
 let _ = out_sig_item := print_out_sig_item
+let _ = out_type_extension := print_out_type_extension
 
 (* Phrases *)
 
@@ -501,6 +583,29 @@ let print_out_exception ppf exn outv =
 let rec print_items ppf =
   function
     [] -> ()
+  | (Osig_typext(ext, Oext_first), None) :: items ->
+      (* Gather together extension constructors *)
+      let rec gather_extensions acc items =
+        match items with
+            (Osig_typext(ext, Oext_next), None) :: items ->
+              gather_extensions
+                ((ext.oext_name, ext.oext_args, ext.oext_ret_type) :: acc)
+                items
+          | _ -> (List.rev acc, items)
+      in
+      let exts, items =
+        gather_extensions
+          [(ext.oext_name, ext.oext_args, ext.oext_ret_type)]
+          items
+      in
+      let te =
+        { otyext_name = ext.oext_type_name;
+          otyext_params = ext.oext_type_params;
+          otyext_constructors = exts;
+          otyext_private = ext.oext_private }
+      in
+        fprintf ppf "@[%a@]" !out_type_extension te;
+        if items <> [] then fprintf ppf "@ %a" print_items items
   | (tree, valopt) :: items ->
       begin match valopt with
         Some v ->
diff --git a/typing/oprint.mli b/typing/oprint.mli
index 56caa60955..1f9ec32b1a 100644
--- a/typing/oprint.mli
+++ b/typing/oprint.mli
@@ -19,6 +19,7 @@ val out_class_type : (formatter -> out_class_type -> unit) ref
 val out_module_type : (formatter -> out_module_type -> unit) ref
 val out_sig_item : (formatter -> out_sig_item -> unit) ref
 val out_signature : (formatter -> out_sig_item list -> unit) ref
+val out_type_extension : (formatter -> out_type_extension -> unit) ref
 val out_phrase : (formatter -> out_phrase -> unit) ref
 
 val parenthesized_ident : string -> bool
diff --git a/typing/outcometree.mli b/typing/outcometree.mli
index eae7b2fbeb..18885e8de6 100644
--- a/typing/outcometree.mli
+++ b/typing/outcometree.mli
@@ -44,6 +44,7 @@ type out_value =
 
 type out_type =
   | Otyp_abstract
+  | Otyp_open
   | Otyp_alias of out_type * string
   | Otyp_arrow of string * out_type * out_type
   | Otyp_class of bool * out_ident * out_type list
@@ -86,18 +87,37 @@ and out_sig_item =
   | Osig_class_type of
       bool * string * (string * (bool * bool)) list * out_class_type *
         out_rec_status
-  | Osig_exception of string * out_type list
+  | Osig_typext of out_extension_constructor * out_ext_status
   | Osig_modtype of string * out_module_type
   | 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 * Asttypes.private_flag *
-  (out_type * out_type) list
+  { otype_name: string;
+    otype_params: (string * (bool * bool)) list;
+    otype_type: out_type;
+    otype_private: Asttypes.private_flag;
+    otype_cstrs: (out_type * out_type) list }
+and out_extension_constructor =
+  { oext_name: string;
+    oext_type_name: string;
+    oext_type_params: string list;
+    oext_args: out_type list;
+    oext_ret_type: out_type option;
+    oext_private: Asttypes.private_flag }
+and out_type_extension =
+  { otyext_name: string;
+    otyext_params: string list;
+    otyext_constructors: (string * out_type list * out_type option) list;
+    otyext_private: Asttypes.private_flag }
 and out_rec_status =
   | Orec_not
   | Orec_first
   | Orec_next
+and out_ext_status =
+  | Oext_first
+  | Oext_next
+  | Oext_exception
 
 type out_phrase =
   | Ophr_eval of out_value * out_type
diff --git a/typing/parmatch.ml b/typing/parmatch.ml
index 64977130f5..8a840b5426 100644
--- a/typing/parmatch.ml
+++ b/typing/parmatch.ml
@@ -110,13 +110,12 @@ and compats ps qs = match ps,qs with
 | p::ps, q::qs -> compat p q && compats ps qs
 | _,_    -> assert false
 
+exception Empty (* Empty pattern *)
+
 (****************************************)
-(* Utilities for retrieving constructor *)
-(* and record label names               *)
+(* Utilities for retrieving type paths  *)
 (****************************************)
 
-exception Empty (* Empty pattern *)
-
 (* May need a clean copy, cf. PR#4745 *)
 let clean_copy ty =
   if ty.level = Btype.generic_level then ty
@@ -128,33 +127,6 @@ let get_type_path ty tenv =
   | Tconstr (path,_,_) -> path
   | _ -> fatal_error "Parmatch.get_type_path"
 
-let get_type_descr ty tenv =
-  match (Ctype.repr ty).desc with
-  | Tconstr (path,_,_) -> Env.find_type path tenv
-  | _ -> fatal_error "Parmatch.get_type_descr"
-
-let rec get_constr tag ty tenv =
-  match get_type_descr ty tenv with
-  | {type_kind=Type_variant constr_list} ->
-      Datarepr.find_constr_by_tag tag constr_list
-  | {type_manifest = Some _} ->
-      get_constr tag (Ctype.expand_head_once tenv (clean_copy ty)) tenv
-  | _ -> fatal_error "Parmatch.get_constr"
-
-let find_label lbl lbls =
-  try
-    let l = List.nth lbls lbl.lbl_pos in
-    l.Types.ld_id
-  with Failure "nth" -> Ident.create "*Unknown label*"
-
-let rec get_record_labels ty tenv =
-  match get_type_descr ty tenv with
-  | {type_kind = Type_record(lbls, rep)} -> lbls
-  | {type_manifest = Some _} ->
-      get_record_labels (Ctype.expand_head_once tenv (clean_copy ty)) tenv
-  | _ -> fatal_error "Parmatch.get_record_labels"
-
-
 (*************************************)
 (* Values as patterns pretty printer *)
 (*************************************)
@@ -162,16 +134,8 @@ let rec get_record_labels ty tenv =
 open Format
 ;;
 
-let get_constr_name tag ty tenv  = match tag with
-| Cstr_exception (path, _) -> Path.name path
-| _ ->
-  try
-    let cd = get_constr tag ty tenv in Ident.name cd.cd_id
-  with
-  | Datarepr.Constr_not_found -> "*Unknown constructor*"
-
-let is_cons tag v  = match get_constr_name tag v.pat_type v.pat_env with
-| "::" -> true
+let is_cons = function
+| {cstr_name = "::"} -> true
 | _ -> false
 
 let pretty_const c = match c with
@@ -201,14 +165,12 @@ let rec pretty_val ppf v =
   | Tpat_constant c -> fprintf ppf "%s" (pretty_const c)
   | Tpat_tuple vs ->
       fprintf ppf "@[(%a)@]" (pretty_vals ",") vs
-  | Tpat_construct (_, {cstr_tag=tag},[]) ->
-      let name = get_constr_name tag v.pat_type v.pat_env in
-      fprintf ppf "%s" name
-  | Tpat_construct (_, {cstr_tag=tag},[w]) ->
-      let name = get_constr_name tag v.pat_type v.pat_env in
-      fprintf ppf "@[<2>%s@ %a@]" name pretty_arg w
-  | Tpat_construct (_, {cstr_tag=tag},vs) ->
-      let name = get_constr_name tag v.pat_type v.pat_env in
+  | Tpat_construct (_, cstr, []) ->
+      fprintf ppf "%s" cstr.cstr_name
+  | Tpat_construct (_, cstr, [w]) ->
+      fprintf ppf "@[<2>%s@ %a@]" cstr.cstr_name pretty_arg w
+  | Tpat_construct (_, cstr, vs) ->
+      let name = cstr.cstr_name in
       begin match (name, vs) with
         ("::", [v1;v2]) ->
           fprintf ppf "@[%a::@,%a@]" pretty_car v1 pretty_cdr v2
@@ -221,7 +183,7 @@ let rec pretty_val ppf v =
       fprintf ppf "@[<2>`%s@ %a@]" l pretty_arg w
   | Tpat_record (lvs,_) ->
       fprintf ppf "@[{%a}@]"
-        (pretty_lvals (get_record_labels v.pat_type v.pat_env))
+        pretty_lvals
         (List.filter
            (function
              | (_,_,{pat_desc=Tpat_any}) -> false (* do not show lbl=_ *)
@@ -236,14 +198,14 @@ let rec pretty_val ppf v =
       fprintf ppf "@[(%a|@,%a)@]" pretty_or v pretty_or w
 
 and pretty_car ppf v = match v.pat_desc with
-| Tpat_construct (_,{cstr_tag=tag}, [_ ; _])
-    when is_cons tag v ->
+| Tpat_construct (_,cstr, [_ ; _])
+    when is_cons cstr ->
       fprintf ppf "(%a)" pretty_val v
 | _ -> pretty_val ppf v
 
 and pretty_cdr ppf v = match v.pat_desc with
-| Tpat_construct (_,{cstr_tag=tag}, [v1 ; v2])
-    when is_cons tag v ->
+| Tpat_construct (_,cstr, [v1 ; v2])
+    when is_cons cstr ->
       fprintf ppf "%a::@,%a" pretty_car v1 pretty_cdr v2
 | _ -> pretty_val ppf v
 
@@ -262,15 +224,13 @@ and pretty_vals sep ppf = function
   | v::vs ->
       fprintf ppf "%a%s@ %a" pretty_val v sep (pretty_vals sep) vs
 
-and pretty_lvals lbls ppf = function
+and pretty_lvals ppf = function
   | [] -> ()
   | [_,lbl,v] ->
-      let name = find_label lbl lbls in
-      fprintf ppf "%s=%a" (Ident.name name) pretty_val v
+      fprintf ppf "%s=%a" lbl.lbl_name pretty_val v
   | (_, lbl,v)::rest ->
-      let name = find_label lbl lbls in
       fprintf ppf "%s=%a;@ %a"
-        (Ident.name name) pretty_val v (pretty_lvals lbls) rest
+        lbl.lbl_name pretty_val v pretty_lvals rest
 
 let top_pretty ppf v =
   fprintf ppf "@[%a@]@?" pretty_val v
@@ -661,16 +621,16 @@ let clean_env env =
   loop env
 
 let full_match ignore_generalized closing env =  match env with
-| ({pat_desc = Tpat_construct (_,{cstr_tag=Cstr_exception _},_)},_)::_ ->
-    false
 | ({pat_desc = Tpat_construct(_,c,_);pat_type=typ},_) :: _ ->
-    if ignore_generalized then
-      (* remove generalized constructors;
-         those cases will be handled separately *)
-      let env = clean_env env in
-      List.length env = c.cstr_normal
+    if c.cstr_consts < 0 then false (* extensions *)
     else
-      List.length env = c.cstr_consts + c.cstr_nonconsts
+      if ignore_generalized then
+        (* remove generalized constructors;
+           those cases will be handled separately *)
+        let env = clean_env env in
+        List.length env = c.cstr_normal
+      else
+        List.length env = c.cstr_consts + c.cstr_nonconsts
 
 | ({pat_desc = Tpat_variant _} as p,_) :: _ ->
     let fields =
@@ -768,19 +728,19 @@ let rec pat_of_constrs ex_pat = function
         (pat_of_constr ex_pat cstr,
          pat_of_constrs ex_pat rem, None)}
 
-exception Not_an_adt
-
-let rec adt_path env ty =
-  match get_type_descr ty env with
-  | {type_kind=Type_variant constr_list} ->
-      begin match (Ctype.repr ty).desc with
-      | Tconstr (path,_,_) ->
-          path
-      | _ -> assert false end
-  | {type_manifest = Some _} ->
-      adt_path env (Ctype.expand_head_once env (clean_copy ty))
-  | _ -> raise Not_an_adt
-;;
+let rec get_variant_constructors env ty =
+  match (Ctype.repr ty).desc with
+  | Tconstr (path,_,_) -> begin
+      match Env.find_type path env with
+      | {type_kind=Type_variant _} ->
+          let (constrs, _, _) = Env.find_type_descrs path env in
+          constrs
+      | {type_manifest = Some _} ->
+          get_variant_constructors env
+            (Ctype.expand_head_once env (clean_copy ty))
+      | _ -> fatal_error "Parmatch.get_variant_constructors"
+    end
+  | _ -> fatal_error "Parmatch.get_variant_constructors"
 
 let rec map_filter f  =
   function
@@ -794,18 +754,12 @@ let rec map_filter f  =
 let complete_constrs p all_tags =
   match p.pat_desc with
   | Tpat_construct (_,c,_) ->
-      begin try
-        let not_tags = complete_tags c.cstr_consts c.cstr_nonconsts all_tags in
-        let (constrs, _, _) =
-          Env.find_type_descrs (adt_path p.pat_env p.pat_type) p.pat_env in
+      let not_tags = complete_tags c.cstr_consts c.cstr_nonconsts all_tags in
+      let constrs = get_variant_constructors p.pat_env c.cstr_res in
         map_filter
           (fun cnstr ->
             if List.mem cnstr.cstr_tag not_tags then Some cnstr else None)
           constrs
-      with
-      | Datarepr.Constr_not_found ->
-          fatal_error "Parmatch.complete_constr: constr_not_found"
-      end
   | _ -> fatal_error "Parmatch.complete_constr"
 
 
@@ -825,16 +779,10 @@ let build_other_constant proj make first next p env =
 *)
 
 let build_other ext env =  match env with
-| ({pat_desc =
-    Tpat_construct (lid, ({cstr_tag=Cstr_exception _} as c),_)},_)
-  ::_ ->
-    make_pat
-      (Tpat_construct
-         (lid, {c with
-           cstr_tag=(Cstr_exception
-            (Path.Pident (Ident.create "*exception*"), Location.none))},
-          []))
-      Ctype.none Env.empty
+| ({pat_desc = Tpat_construct (lid,
+      ({cstr_tag=Cstr_extension _} as c),_)},_) :: _ ->
+    let c = {c with cstr_name = "*extension*"} in
+      make_pat (Tpat_construct(lid, c, [])) Ctype.none Env.empty
 | ({pat_desc = Tpat_construct (_, _,_)} as p,_) :: _ ->
     begin match ext with
     | Some ext when Path.same ext (get_type_path p.pat_type p.pat_env) ->
@@ -1921,7 +1869,7 @@ let rec collect_paths_from_pat r p = match p.pat_desc with
       ps
 | Tpat_any|Tpat_var _|Tpat_constant _| Tpat_variant (_,None,_) -> r
 | Tpat_tuple ps | Tpat_array ps
-| Tpat_construct (_, {cstr_tag=Cstr_exception _}, ps)->
+| Tpat_construct (_, {cstr_tag=Cstr_extension _}, ps)->
     List.fold_left collect_paths_from_pat r ps
 | Tpat_record (lps,_) ->
     List.fold_left
@@ -1990,7 +1938,7 @@ let check_unused tdefs casel =
                         p.pat_loc Warnings.Unused_pat)
                     ps
               | Used -> ()
-            with Empty | Not_an_adt | Not_found | NoGuard -> assert false
+            with Empty | Not_found | NoGuard -> assert false
             end ;
 
           if c_guard <> None then
diff --git a/typing/predef.ml b/typing/predef.ml
index 55fe4b880e..bcad58efdd 100644
--- a/typing/predef.ml
+++ b/typing/predef.ml
@@ -35,12 +35,12 @@ and ident_unit = ident_create "unit"
 and ident_exn = ident_create "exn"
 and ident_array = ident_create "array"
 and ident_list = ident_create "list"
-and ident_format6 = ident_create "format6"
 and ident_option = ident_create "option"
 and ident_nativeint = ident_create "nativeint"
 and ident_int32 = ident_create "int32"
 and ident_int64 = ident_create "int64"
 and ident_lazy_t = ident_create "lazy_t"
+and ident_bytes = ident_create "bytes"
 
 let path_int = Pident ident_int
 and path_char = Pident ident_char
@@ -51,12 +51,12 @@ and path_unit = Pident ident_unit
 and path_exn = Pident ident_exn
 and path_array = Pident ident_array
 and path_list = Pident ident_list
-and path_format6 = Pident ident_format6
 and path_option = Pident ident_option
 and path_nativeint = Pident ident_nativeint
 and path_int32 = Pident ident_int32
 and path_int64 = Pident ident_int64
 and path_lazy_t = Pident ident_lazy_t
+and path_bytes = Pident ident_bytes
 
 let type_int = newgenty (Tconstr(path_int, [], ref Mnil))
 and type_char = newgenty (Tconstr(path_char, [], ref Mnil))
@@ -72,6 +72,7 @@ and type_nativeint = newgenty (Tconstr(path_nativeint, [], ref Mnil))
 and type_int32 = newgenty (Tconstr(path_int32, [], ref Mnil))
 and type_int64 = newgenty (Tconstr(path_int64, [], ref Mnil))
 and type_lazy_t t = newgenty (Tconstr(path_lazy_t, [t], ref Mnil))
+and type_bytes = newgenty (Tconstr(path_bytes, [], ref Mnil))
 
 let ident_match_failure = ident_create_predef_exn "Match_failure"
 and ident_out_of_memory = ident_create_predef_exn "Out_of_memory"
@@ -119,7 +120,7 @@ and ident_nil = ident_create "[]"
 and ident_cons = ident_create "::"
 and ident_none = ident_create "None"
 and ident_some = ident_create "Some"
-let build_initial_env add_type add_exception empty_env =
+let common_initial_env add_type add_extension empty_env =
   let decl_bool =
     {decl_abstr with
      type_kind = Type_variant([cstr ident_false []; cstr ident_true []])}
@@ -128,7 +129,7 @@ let build_initial_env add_type add_exception empty_env =
      type_kind = Type_variant([cstr ident_void []])}
   and decl_exn =
     {decl_abstr with
-     type_kind = Type_variant []}
+     type_kind = Type_open}
   and decl_array =
     let tvar = newgenvar() in
     {decl_abstr with
@@ -143,12 +144,6 @@ let build_initial_env add_type add_exception empty_env =
      type_kind =
      Type_variant([cstr ident_nil []; cstr ident_cons [tvar; type_list tvar]]);
      type_variance = [Variance.covariant]}
-  and decl_format6 =
-    let params = List.map (newgenvar ?name:None) [();();();();();()] in
-    {decl_abstr with
-     type_params = params;
-     type_arity = 6;
-     type_variance = List.map (fun _ -> Variance.full) params}
   and decl_option =
     let tvar = newgenvar() in
     {decl_abstr with
@@ -164,31 +159,36 @@ let build_initial_env add_type add_exception empty_env =
      type_variance = [Variance.covariant]}
   in
 
-  let add_exception id l =
-    add_exception id
-      { exn_args = Cstr_tuple l; exn_loc = Location.none; exn_attributes = [] }
+  let add_extension id l =
+    add_extension id
+      { ext_type_path = path_exn;
+        ext_type_params = [];
+        ext_args = Cstr_tuple l;
+        ext_ret_type = None;
+        ext_private = Asttypes.Public;
+        ext_loc = Location.none;
+        ext_attributes = [] }
   in
-  add_exception ident_match_failure
+  add_extension ident_match_failure
                          [newgenty (Ttuple[type_string; type_int; type_int])] (
-  add_exception ident_out_of_memory [] (
-  add_exception ident_stack_overflow [] (
-  add_exception ident_invalid_argument [type_string] (
-  add_exception ident_failure [type_string] (
-  add_exception ident_not_found [] (
-  add_exception ident_sys_blocked_io [] (
-  add_exception ident_sys_error [type_string] (
-  add_exception ident_end_of_file [] (
-  add_exception ident_division_by_zero [] (
-  add_exception ident_assert_failure
+  add_extension ident_out_of_memory [] (
+  add_extension ident_stack_overflow [] (
+  add_extension ident_invalid_argument [type_string] (
+  add_extension ident_failure [type_string] (
+  add_extension ident_not_found [] (
+  add_extension ident_sys_blocked_io [] (
+  add_extension ident_sys_error [type_string] (
+  add_extension ident_end_of_file [] (
+  add_extension ident_division_by_zero [] (
+  add_extension ident_assert_failure
                          [newgenty (Ttuple[type_string; type_int; type_int])] (
-  add_exception ident_undefined_recursive_module
+  add_extension ident_undefined_recursive_module
                          [newgenty (Ttuple[type_string; type_int; type_int])] (
   add_type ident_int64 decl_abstr (
   add_type ident_int32 decl_abstr (
   add_type ident_nativeint decl_abstr (
   add_type ident_lazy_t decl_lazy_t (
   add_type ident_option decl_option (
-  add_type ident_format6 decl_format6 (
   add_type ident_list decl_list (
   add_type ident_array decl_array (
   add_type ident_exn decl_exn (
@@ -198,7 +198,14 @@ let build_initial_env add_type add_exception empty_env =
   add_type ident_string decl_abstr (
   add_type ident_char decl_abstr (
   add_type ident_int decl_abstr (
-    empty_env)))))))))))))))))))))))))))
+    empty_env))))))))))))))))))))))))))
+
+let build_initial_env add_type add_exception empty_env =
+  let common = common_initial_env add_type add_exception empty_env in
+  let safe_string = add_type ident_bytes decl_abstr common in
+  let decl_bytes_unsafe = {decl_abstr with type_manifest = Some type_string} in
+  let unsafe_string = add_type ident_bytes decl_bytes_unsafe common in
+  (safe_string, unsafe_string)
 
 let builtin_values =
   List.map (fun id -> Ident.make_global id; (Ident.name id, id))
diff --git a/typing/predef.mli b/typing/predef.mli
index a2f4724718..9723671165 100644
--- a/typing/predef.mli
+++ b/typing/predef.mli
@@ -17,6 +17,7 @@ open Types
 val type_int: type_expr
 val type_char: type_expr
 val type_string: type_expr
+val type_bytes: type_expr
 val type_float: type_expr
 val type_bool: type_expr
 val type_unit: type_expr
@@ -32,13 +33,13 @@ val type_lazy_t: type_expr -> type_expr
 val path_int: Path.t
 val path_char: Path.t
 val path_string: Path.t
+val path_bytes: Path.t
 val path_float: Path.t
 val path_bool: Path.t
 val path_unit: Path.t
 val path_exn: Path.t
 val path_array: Path.t
 val path_list: Path.t
-val path_format6: Path.t
 val path_option: Path.t
 val path_nativeint: Path.t
 val path_int32: Path.t
@@ -51,12 +52,12 @@ val path_undefined_recursive_module : Path.t
 
 (* To build the initial environment. Since there is a nasty mutual
    recursion between predef and env, we break it by parameterizing
-   over Env.t, Env.add_type and Env.add_exception. *)
+   over Env.t, Env.add_type and Env.add_extension. *)
 
 val build_initial_env:
   (Ident.t -> type_declaration -> 'a -> 'a) ->
-  (Ident.t -> exception_declaration -> 'a -> 'a) ->
-  'a -> 'a
+  (Ident.t -> extension_constructor -> 'a -> 'a) ->
+  'a -> 'a * 'a
 
 (* To initialize linker tables *)
 
diff --git a/typing/printtyp.ml b/typing/printtyp.ml
index ee39b36ded..c86d245165 100644
--- a/typing/printtyp.ml
+++ b/typing/printtyp.ml
@@ -790,6 +790,7 @@ let rec tree_of_type_decl id decl =
         cstrs
   | Type_record(l, rep) ->
       List.iter (fun l -> mark_loops l.ld_type) l
+  | Type_open -> ()
   end;
 
   let type_param =
@@ -807,6 +808,8 @@ let rec tree_of_type_decl id decl =
       | Type_variant tll ->
           decl.type_private = Private ||
           List.exists (fun cd -> cd.cd_res <> None) tll
+      | Type_open ->
+          decl.type_manifest = None
     in
     let vari =
       List.map2
@@ -840,8 +843,15 @@ let rec tree_of_type_decl id decl =
     | Type_record(lbls, rep) ->
         tree_of_manifest (Otyp_record (List.map tree_of_label lbls)),
         decl.type_private
+    | Type_open ->
+        tree_of_manifest Otyp_open,
+        Public
   in
-  (name, args, ty, priv, constraints)
+    { otype_name = name;
+      otype_params = args;
+      otype_type = ty;
+      otype_private = priv;
+      otype_cstrs = constraints }
 
 and tree_of_constructor_arguments = function
   | Cstr_tuple l -> tree_of_typlist false l
@@ -860,12 +870,6 @@ and tree_of_constructor cd =
       names := nm;
       (name, args, Some ret)
 
-
-and tree_of_constructor_ret =
-  function
-    | None -> None
-    | Some ret_type -> Some (tree_of_typexp false ret_type)
-
 and tree_of_label l =
   (Ident.name l.ld_id, l.ld_mutable = Mutable, tree_of_typexp false l.ld_type)
 
@@ -875,16 +879,55 @@ let tree_of_type_declaration id decl rs =
 let type_declaration id ppf decl =
   !Oprint.out_sig_item ppf (tree_of_type_declaration id decl Trec_first)
 
-(* Print an exception declaration *)
+(* Print an extension declaration *)
 
-let tree_of_exception_declaration id decl =
+let tree_of_extension_constructor id ext es =
   reset ();
-  mark_loops_constructor_arguments decl.exn_args;
-  let tyl = tree_of_constructor_arguments decl.exn_args in
-  Osig_exception (Ident.name id, tyl)
+  let ty_name = Path.name ext.ext_type_path in
+  let ty_params = filter_params ext.ext_type_params in
+  List.iter add_alias ty_params;
+  List.iter mark_loops ty_params;
+  List.iter check_name_of_type (List.map proxy ty_params);
+  mark_loops_constructor_arguments ext.ext_args;
+  may mark_loops ext.ext_ret_type;
+  let type_param =
+    function
+    | Otyp_var (_, id) -> id
+    | _ -> "?"
+  in
+  let ty_params =
+    List.map (fun ty -> type_param (tree_of_typexp false ty)) ty_params
+  in
+  let name = Ident.name id in
+  let args, ret =
+    match ext.ext_ret_type with
+    | None -> (tree_of_constructor_arguments ext.ext_args, None)
+    | Some res ->
+        let nm = !names in
+        names := [];
+        let ret = tree_of_typexp false res in
+        let args = tree_of_constructor_arguments ext.ext_args in
+        names := nm;
+        (args, Some ret)
+  in
+  let ext =
+    { oext_name = name;
+      oext_type_name = ty_name;
+      oext_type_params = ty_params;
+      oext_args = args;
+      oext_ret_type = ret;
+      oext_private = ext.ext_private }
+  in
+  let es =
+    match es with
+        Text_first -> Oext_first
+      | Text_next -> Oext_next
+      | Text_exception -> Oext_exception
+  in
+    Osig_typext (ext, es)
 
-let exception_declaration id ppf decl =
-  !Oprint.out_sig_item ppf (tree_of_exception_declaration id decl)
+let extension_constructor id ppf ext =
+  !Oprint.out_sig_item ppf (tree_of_extension_constructor id ext Text_first)
 
 (* Print a value declaration *)
 
@@ -1151,8 +1194,8 @@ and trees_of_sigitem = function
       []
   | Sig_type(id, decl, rs) ->
       [tree_of_type_declaration id decl rs]
-  | Sig_exception(id, decl) ->
-      [tree_of_exception_declaration id decl]
+  | Sig_typext(id, ext, es) ->
+      [tree_of_extension_constructor id ext es]
   | Sig_module(id, md, rs) ->
       [tree_of_module id md.md_type rs]
   | Sig_modtype(id, decl) ->
diff --git a/typing/printtyp.mli b/typing/printtyp.mli
index 82b8608e54..531b0e9954 100644
--- a/typing/printtyp.mli
+++ b/typing/printtyp.mli
@@ -47,10 +47,10 @@ 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_extension_constructor:
+    Ident.t -> extension_constructor -> ext_status -> out_sig_item
+val extension_constructor:
+    Ident.t -> formatter -> extension_constructor -> unit
 val tree_of_module: Ident.t -> module_type -> rec_status -> out_sig_item
 val modtype: formatter -> module_type -> unit
 val signature: formatter -> signature -> unit
diff --git a/typing/printtyped.ml b/typing/printtyped.ml
index 9ef36b20aa..608fb44a06 100644
--- a/typing/printtyped.ml
+++ b/typing/printtyped.ml
@@ -171,8 +171,9 @@ let rec core_type i ppf x =
       line i ppf "Ptyp_object %a\n" fmt_closed_flag c;
       let i = i + 1 in
       List.iter
-        (fun (s, t) ->
-          line i ppf "method %s" s;
+        (fun (s, attrs, t) ->
+          line i ppf "method %s\n" s;
+          attributes i ppf attrs;
           core_type (i + 1) ppf t
         )
         l
@@ -186,7 +187,7 @@ let rec core_type i ppf x =
       line i ppf "Ptyp_poly%a\n"
         (fun ppf -> List.iter (fun x -> fprintf ppf " '%s" x)) sl;
       core_type i ppf ct;
-  | Ttyp_package { pack_name = s; pack_fields = l } ->
+  | Ttyp_package { pack_path = s; pack_fields = l } ->
       line i ppf "Ptyp_package %a\n" fmt_path s;
       list i package_with ppf l;
 
@@ -288,10 +289,11 @@ and expression i ppf x =
       line i ppf "Pexp_apply\n";
       expression i ppf e;
       list i label_x_expression ppf l;
-  | Texp_match (e, l, partial) ->
+  | Texp_match (e, l1, l2, partial) ->
       line i ppf "Pexp_match\n";
       expression i ppf e;
-      list i case ppf l;
+      list i case ppf l1;
+      list i case ppf l2;
   | Texp_try (e, l) ->
       line i ppf "Pexp_try\n";
       expression i ppf e;
@@ -377,12 +379,7 @@ and value_description i ppf x =
   core_type (i+1) ppf x.val_desc;
   list (i+1) string ppf x.val_prim;
 
-and type_parameter i ppf (x, _variance) =
-  match x with
-  | Some x ->
-      string i ppf x.txt
-  | None ->
-      string i ppf "_"
+and type_parameter i ppf (x, _variance) = core_type i ppf x
 
 and type_declaration i ppf x =
   line i ppf "type_declaration %a %a\n" fmt_ident x.typ_id fmt_location x.typ_loc;
@@ -408,6 +405,37 @@ and type_kind i ppf x =
   | Ttype_record l ->
       line i ppf "Ptype_record\n";
       list (i+1) label_decl ppf l;
+  | Ttype_open ->
+      line i ppf "Ptype_open\n"
+
+and type_extension i ppf x =
+  line i ppf "type_extension\n";
+  attributes i ppf x.tyext_attributes;
+  let i = i+1 in
+  line i ppf "ptyext_path = %a\n" fmt_path x.tyext_path;
+  line i ppf "ptyext_params =\n";
+  list (i+1) type_parameter ppf x.tyext_params;
+  line i ppf "ptyext_constructors =\n";
+  list (i+1) extension_constructor ppf x.tyext_constructors;
+  line i ppf "ptyext_private = %a\n" fmt_private_flag x.tyext_private;
+
+and extension_constructor i ppf x =
+  line i ppf "extension_constructor %a\n" fmt_location x.ext_loc;
+  attributes i ppf x.ext_attributes;
+  let i = i + 1 in
+  line i ppf "pext_name = \"%a\"\n" fmt_ident x.ext_id;
+  line i ppf "pext_kind =\n";
+  extension_constructor_kind (i + 1) ppf x.ext_kind;
+
+and extension_constructor_kind i ppf x =
+  match x with
+      Text_decl(a, r) ->
+        line i ppf "Pext_decl\n";
+        constructor_arguments (i+1) ppf a;
+        option (i+1) core_type ppf r;
+    | Text_rebind(p, _) ->
+        line i ppf "Pext_rebind\n";
+        line (i+1) ppf "%a\n" fmt_path p;
 
 and class_type i ppf x =
   line i ppf "class_type %a\n" fmt_location x.cltyp_loc;
@@ -449,6 +477,9 @@ and class_type_field i ppf x =
       line i ppf "Pctf_constraint\n";
       core_type (i+1) ppf ct1;
       core_type (i+1) ppf ct2;
+  | Tctf_attribute (s, arg) ->
+      line i ppf "Pctf_attribute \"%s\"\n" s.txt;
+      Printast.payload i ppf arg
 
 and class_description i ppf x =
   line i ppf "class_description %a\n" fmt_location x.ci_loc;
@@ -456,7 +487,7 @@ and class_description i ppf x =
   let i = i+1 in
   line i ppf "pci_virt = %a\n" fmt_virtual_flag x.ci_virt;
   line i ppf "pci_params =\n";
-  cl_type_parameters (i+1) ppf x.ci_params;
+  list (i+1) type_parameter ppf x.ci_params;
   line i ppf "pci_name = \"%s\"\n" x.ci_id_name.txt;
   line i ppf "pci_expr =\n";
   class_type (i+1) ppf x.ci_expr;
@@ -466,7 +497,7 @@ and class_type_declaration i ppf x =
   let i = i+1 in
   line i ppf "pci_virt = %a\n" fmt_virtual_flag x.ci_virt;
   line i ppf "pci_params =\n";
-  cl_type_parameters (i+1) ppf x.ci_params;
+  list (i+1) type_parameter ppf x.ci_params;
   line i ppf "pci_name = \"%s\"\n" x.ci_id_name.txt;
   line i ppf "pci_expr =\n";
   class_type (i+1) ppf x.ci_expr;
@@ -546,7 +577,7 @@ and class_declaration i ppf x =
   let i = i+1 in
   line i ppf "pci_virt = %a\n" fmt_virtual_flag x.ci_virt;
   line i ppf "pci_params =\n";
-  cl_type_parameters (i+1) ppf x.ci_params;
+  list (i+1) type_parameter ppf x.ci_params;
   line i ppf "pci_name = \"%s\"\n" x.ci_id_name.txt;
   line i ppf "pci_expr =\n";
   class_expr (i+1) ppf x.ci_expr;
@@ -585,9 +616,12 @@ and signature_item i ppf x =
   | Tsig_type l ->
       line i ppf "Psig_type\n";
       list i type_declaration ppf l;
-  | Tsig_exception cd ->
+  | Tsig_typext e ->
+      line i ppf "Psig_typext\n";
+      type_extension i ppf e;
+  | Tsig_exception ext ->
       line i ppf "Psig_exception\n";
-      constructor_decl i ppf cd
+      extension_constructor i ppf ext
   | Tsig_module md ->
       line i ppf "Psig_module \"%a\"\n" fmt_ident md.md_id;
       attributes i ppf md.md_attributes;
@@ -691,14 +725,12 @@ and structure_item i ppf x =
   | Tstr_type l ->
       line i ppf "Pstr_type\n";
       list i type_declaration ppf l;
-  | Tstr_exception cd ->
+  | Tstr_typext te ->
+      line i ppf "Pstr_typext\n";
+      type_extension i ppf te
+  | Tstr_exception ext ->
       line i ppf "Pstr_exception\n";
-      constructor_decl i ppf cd;
-  | Tstr_exn_rebind er ->
-      line i ppf "Pstr_exn_rebind \"%a\" %a\n"
-           fmt_ident er.exrb_id
-           fmt_path er.exrb_path;
-      attributes i ppf er.exrb_attributes
+      extension_constructor i ppf ext;
   | Tstr_module x ->
       line i ppf "Pstr_module\n";
       module_binding i ppf x
@@ -748,14 +780,15 @@ and core_type_x_core_type_x_location i ppf (ct1, ct2, l) =
 
 and constructor_decl i ppf {cd_id; cd_name = _; cd_args; cd_res; cd_loc; cd_attributes} =
   line i ppf "%a\n" fmt_location cd_loc;
-  attributes i ppf cd_attributes;
   line (i+1) ppf "%a\n" fmt_ident cd_id;
-  begin match cd_args with
-  | Cstr_tuple l -> list (i+1) core_type ppf l;
-  | Cstr_record l -> list (i+1) label_decl ppf l
-  end;
+  attributes i ppf cd_attributes;
+  constructor_arguments (i+1) ppf cd_args;
   option (i+1) core_type ppf cd_res
 
+and constructor_arguments i ppf = function
+  | Cstr_tuple l -> list i core_type ppf l
+  | Cstr_record l -> list i label_decl ppf l
+
 and label_decl i ppf {ld_id; ld_name = _; ld_mutable; ld_type; ld_loc; ld_attributes} =
   line i ppf "%a\n" fmt_location ld_loc;
   attributes i ppf ld_attributes;
@@ -763,13 +796,6 @@ and label_decl i ppf {ld_id; ld_name = _; ld_mutable; ld_type; ld_loc; ld_attrib
   line (i+1) ppf "%a" fmt_ident ld_id;
   core_type (i+1) ppf ld_type
 
-and cl_type_parameters i ppf l =
-  line i ppf "<params>\n";
-  list (i+1) cl_type_parameter ppf l;
-
-and cl_type_parameter i ppf (x, _variance) =
-  string_loc i ppf x
-
 and longident_x_pattern i ppf (li, _, p) =
   line i ppf "%a\n" fmt_longident li;
   pattern (i+1) ppf p;
@@ -807,8 +833,9 @@ and ident_x_loc_x_expression_def i ppf (l,_, e) =
 
 and label_x_bool_x_core_type_list i ppf x =
   match x with
-    Ttag (l, b, ctl) ->
+    Ttag (l, attrs, b, ctl) ->
       line i ppf "Rtag \"%s\" %s\n" l (string_of_bool b);
+      attributes (i+1) ppf attrs;
       list (i+1) core_type ppf ctl
   | Tinherit (ct) ->
       line i ppf "Rinherit\n";
diff --git a/typing/subst.ml b/typing/subst.ml
index eb4e7b3c04..0fb9764d33 100644
--- a/typing/subst.ml
+++ b/typing/subst.ml
@@ -50,7 +50,7 @@ let sub_ids decl =
   | _ -> []
 
 
-let sub_ids_exn exn = sub_ids_args exn.exn_args
+let sub_ids_ext ext = sub_ids_args ext.ext_args
 
 let add_prefixes root ids sub =
   List.fold_left
@@ -256,6 +256,7 @@ let type_declaration s decl =
                  cstrs)
         | Type_record(lbls, rep) ->
             Type_record (List.map (label_declaration s) lbls, rep)
+        | Type_open -> Type_open
         end;
       type_manifest =
         begin
@@ -337,15 +338,18 @@ let value_description s descr =
     val_attributes = attrs s descr.val_attributes;
    }
 
-let exception_declaration s descr =
-  let r =
-    { exn_args = constructor_arguments s descr.exn_args;
-      exn_loc = loc s descr.exn_loc;
-      exn_attributes = attrs s descr.exn_attributes;
-    }
+let extension_constructor s ext =
+  let ext =
+    { ext_type_path = type_path s ext.ext_type_path;
+      ext_type_params = List.map (typexp s) ext.ext_type_params;
+      ext_args = constructor_arguments s ext.ext_args;
+      ext_ret_type = may_map (typexp s) ext.ext_ret_type;
+      ext_private = ext.ext_private;
+      ext_attributes = ext.ext_attributes;
+      ext_loc = if s.for_saving then Location.none else ext.ext_loc; }
   in
-  cleanup_types ();
-  r
+    cleanup_types ();
+    ext
 
 let rec rename_bound_idents s idents = function
     [] -> (List.rev idents, s)
@@ -360,8 +364,8 @@ let rec rename_bound_idents s idents = function
       let id' = Ident.rename id in
       rename_bound_idents (add_modtype id (Mty_ident(Pident id')) s)
                           (id' :: idents) sg
-  | Sig_exception(id, d) :: sg ->
-      let s = rename_types (sub_ids_exn d) s in
+  | Sig_typext(id, d, _) :: sg ->
+      let s = rename_types (sub_ids_ext d) s in
       let id' = Ident.rename id in
       rename_bound_idents s (id' :: idents) sg
   | (Sig_value(id, _) | Sig_class(id, _, _) | Sig_class_type(id, _, _)) :: sg ->
@@ -404,8 +408,8 @@ and signature_component s comp newid =
       Sig_value(newid, value_description s d)
   | Sig_type(id, d, rs) ->
       Sig_type(newid, type_declaration s d, rs)
-  | Sig_exception(id, d) ->
-      Sig_exception(newid, exception_declaration s d)
+  | Sig_typext(id, ext, es) ->
+      Sig_typext(newid, extension_constructor s ext, es)
   | Sig_module(id, d, rs) ->
       Sig_module(newid, module_declaration s d, rs)
   | Sig_modtype(id, d) ->
diff --git a/typing/subst.mli b/typing/subst.mli
index 4d6762374b..38fad596b8 100644
--- a/typing/subst.mli
+++ b/typing/subst.mli
@@ -43,8 +43,8 @@ val type_expr: t -> type_expr -> type_expr
 val class_type: t -> class_type -> class_type
 val value_description: t -> value_description -> value_description
 val type_declaration: t -> type_declaration -> type_declaration
-val exception_declaration:
-        t -> exception_declaration -> exception_declaration
+val extension_constructor:
+        t -> extension_constructor -> extension_constructor
 val class_declaration: t -> class_declaration -> class_declaration
 val cltype_declaration: t -> class_type_declaration -> class_type_declaration
 val modtype: t -> module_type -> module_type
@@ -58,7 +58,7 @@ val compose: t -> t -> t
 
 
 val sub_ids: type_declaration -> Ident.t list
-val sub_ids_exn: exception_declaration -> Ident.t list
+val sub_ids_ext: extension_constructor -> Ident.t list
 
 
 val add_prefixes: Path.t -> Ident.t list -> t -> t
diff --git a/typing/typeclass.ml b/typing/typeclass.ml
index 79c8bc7ee8..3bed6ed7d3 100644
--- a/typing/typeclass.ml
+++ b/typing/typeclass.ml
@@ -46,9 +46,9 @@ type error =
   | Mutability_mismatch of string * mutable_flag
   | No_overriding of string * string
   | Duplicate of string * string
-  | Extension of string
 
 exception Error of Location.t * Env.t * error
+exception Error_forward of Location.error
 
 open Typedtree
 
@@ -410,8 +410,13 @@ let rec class_type_field env self_type meths
       (mkctf (Tctf_constraint (cty, cty')) :: fields,
         val_sig, concr_meths, inher)
 
-  | Pctf_extension (s, _arg) ->
-      raise (Error (s.loc, env, Extension s.txt))
+  | Pctf_attribute x ->
+      Typetexp.warning_attribute [x];
+      (mkctf (Tctf_attribute x) :: fields,
+        val_sig, concr_meths, inher)
+
+  | Pctf_extension ext ->
+      raise (Error_forward (Typetexp.error_of_extension ext))
 
 and class_signature env {pcsig_self=sty; pcsig_fields=sign} =
   let meths = ref Meths.empty in
@@ -432,11 +437,13 @@ and class_signature env {pcsig_self=sty; pcsig_fields=sign} =
   end;
 
   (* Class type fields *)
+  Typetexp.warning_enter_scope ();
   let (fields, val_sig, concr_meths, inher) =
     List.fold_left (class_type_field env self_type meths)
       ([], Vars.empty, Concr.empty, [])
       sign
   in
+  Typetexp.warning_leave_scope ();
   let cty =   {csig_self = self_type;
    csig_vars = val_sig;
    csig_concr = concr_meths;
@@ -494,8 +501,8 @@ and class_type env scty =
       let clty = class_type env scty in
       let typ = Cty_arrow (l, ty, clty.cltyp_type) in
       cltyp (Tcty_arrow (l, cty, clty)) typ
-  | Pcty_extension (s, _arg) ->
-      raise (Error (s.loc, env, Extension s.txt))
+  | Pcty_extension ext ->
+      raise (Error_forward (Typetexp.error_of_extension ext))
 
 let class_type env scty =
   delayed_meth_specs := [];
@@ -700,9 +707,13 @@ let rec class_field self_loc cl_num self_type meths vars
         end in
       (val_env, met_env, par_env, field::fields, concr_meths, warn_vals,
        inher, local_meths, local_vals)
-
-  | Pcf_extension (s, _arg) ->
-      raise (Error (s.loc, val_env, Extension s.txt))
+  | Pcf_attribute x ->
+      Typetexp.warning_attribute [x];
+      (val_env, met_env, par_env,
+        lazy (mkcf (Tcf_attribute x)) :: fields,
+        concr_meths, warn_vals, inher, local_meths, local_vals)
+  | Pcf_extension ext ->
+      raise (Error_forward (Typetexp.error_of_extension ext))
 
 and class_structure cl_num final val_env met_env loc
   { pcstr_self = spat; pcstr_fields = str } =
@@ -751,12 +762,14 @@ and class_structure cl_num final val_env met_env loc
   end;
 
   (* Typing of class fields *)
+  Typetexp.warning_enter_scope ();
   let (_, _, _, fields, concr_meths, _, inher, _local_meths, _local_vals) =
     List.fold_left (class_field self_loc cl_num self_type meths vars)
       (val_env, meth_env, par_env, [], Concr.empty, Concr.empty, [],
        Concr.empty, Concr.empty)
       str
   in
+  Typetexp.warning_leave_scope ();
   Ctype.unify val_env self_type (Ctype.newvar ());
   let sign =
     {csig_self = public_self;
@@ -1132,8 +1145,8 @@ and class_expr cl_num val_env met_env scl =
           cl_env = val_env;
           cl_attributes = scl.pcl_attributes;
          }
-  | Pcl_extension (s, _arg) ->
-      raise (Error (s.loc, val_env, Extension s.txt))
+  | Pcl_extension ext ->
+      raise (Error_forward (Typetexp.error_of_extension ext))
 
 (*******************************)
 
@@ -1252,12 +1265,16 @@ let class_infos define_class kind
   Ctype.begin_class_def ();
 
   (* Introduce class parameters *)
-  let params =
-    try
-      List.map (fun (x, _v) -> enter_type_variable x) cl.pci_params
-    with Already_bound loc ->
-      raise(Error(loc, env, Repeated_parameter))
+  let ci_params =
+    let make_param (sty, v) =
+      try
+          (transl_type_param env sty, v)
+      with Already_bound ->
+        raise(Error(sty.ptyp_loc, env, Repeated_parameter))
+    in
+      List.map make_param cl.pci_params
   in
+  let params = List.map (fun (cty, _) -> cty.ctyp_type) ci_params in
 
   (* Allow self coercions (only for class declarations) *)
   let coercion_locs = ref [] in
@@ -1443,12 +1460,12 @@ let class_infos define_class kind
      type_attributes = []; (* or keep attrs from cl? *)
     }
   in
-  ((cl, id, clty, ty_id, cltydef, obj_id, obj_abbr, cl_id, cl_abbr,
+  ((cl, id, clty, ty_id, cltydef, obj_id, obj_abbr, cl_id, cl_abbr, ci_params,
     arity, pub_meths, List.rev !coercion_locs, expr) :: res,
    env)
 
 let final_decl env define_class
-    (cl, id, clty, ty_id, cltydef, obj_id, obj_abbr, cl_id, cl_abbr,
+    (cl, id, clty, ty_id, cltydef, obj_id, obj_abbr, cl_id, cl_abbr, ci_params,
      arity, pub_meths, coe, expr) =
 
   begin try Ctype.collapse_conj_params env clty.cty_params
@@ -1485,7 +1502,7 @@ let final_decl env define_class
    arity, pub_meths, coe, expr,
    { ci_loc = cl.pci_loc;
      ci_virt = cl.pci_virt;
-     ci_params = cl.pci_params;
+     ci_params = ci_params;
 (* TODO : check that we have the correct use of identifiers *)
      ci_id_name = cl.pci_name;
      ci_id_class = id;
@@ -1818,8 +1835,6 @@ let report_error env ppf = function
   | Duplicate (kind, name) ->
       fprintf ppf "@[The %s `%s'@ has multiple definitions in this object@]"
                     kind name
-  | Extension s ->
-      fprintf ppf "Uninterpreted extension '%s'." s
 
 let report_error env ppf err =
   Printtyp.wrap_printing_env env (fun () -> report_error env ppf err)
@@ -1829,6 +1844,8 @@ let () =
     (function
       | Error (loc, env, err) ->
         Some (Location.error_of_printer loc (report_error env) err)
+      | Error_forward err ->
+        Some err
       | _ ->
         None
     )
diff --git a/typing/typeclass.mli b/typing/typeclass.mli
index a4a360bcc5..8e8675fe76 100644
--- a/typing/typeclass.mli
+++ b/typing/typeclass.mli
@@ -104,8 +104,8 @@ type error =
   | Mutability_mismatch of string * mutable_flag
   | No_overriding of string * string
   | Duplicate of string * string
-  | Extension of string
 
 exception Error of Location.t * Env.t * error
+exception Error_forward of Location.error
 
 val report_error : Env.t -> formatter -> error -> unit
diff --git a/typing/typecore.ml b/typing/typecore.ml
index c42a921427..6494f22872 100644
--- a/typing/typecore.ml
+++ b/typing/typecore.ml
@@ -37,8 +37,7 @@ type error =
   | Wrong_name of string * type_expr * string * Path.t * Longident.t
   | Name_type_mismatch of
       string * Longident.t * (Path.t * Path.t) * (Path.t * Path.t) list
-  | Incomplete_format of string
-  | Bad_conversion of string * int * char
+  | Invalid_format of string
   | Undefined_method of type_expr * string
   | Undefined_inherited_method of string
   | Virtual_class of Longident.t
@@ -66,9 +65,11 @@ type error =
   | Unqualified_gadt_pattern of Path.t * string
   | Invalid_interval
   | Invalid_for_loop_index
-  | Extension of string
+  | No_value_clauses
+  | Exception_pattern_below_toplevel
 
 exception Error of Location.t * Env.t * error
+exception Error_forward of Location.error
 
 (* Forward declaration, to be filled in by Typemod.type_module *)
 
@@ -183,13 +184,13 @@ let iter_expression f e =
     | Pstr_value (_, pel) -> List.iter binding pel
     | Pstr_primitive _
     | Pstr_type _
+    | Pstr_typext _
     | Pstr_exception _
     | Pstr_modtype _
     | Pstr_open _
     | Pstr_class_type _
     | Pstr_attribute _
-    | Pstr_extension _
-    | Pstr_exn_rebind _ -> ()
+    | Pstr_extension _ -> ()
     | Pstr_include {pincl_mod = me}
     | Pstr_module {pmb_expr = me} -> module_expr me
     | Pstr_recmodule l -> List.iter (fun x -> module_expr x.pmb_expr) l
@@ -215,7 +216,7 @@ let iter_expression f e =
     | Pcf_val (_, _, Cfk_concrete (_, e))
     | Pcf_method (_, _, Cfk_concrete (_, e)) -> expr e
     | Pcf_initializer e -> expr e
-    | Pcf_extension _ -> ()
+    | Pcf_attribute _ | Pcf_extension _ -> ()
 
   in
   expr e
@@ -257,14 +258,14 @@ let mkexp exp_desc exp_type exp_loc exp_env =
   { exp_desc; exp_type; exp_loc; exp_env; exp_extra = []; exp_attributes = [] }
 
 let option_none ty loc =
-  let lid = Longident.Lident "None" in
-  let cnone = Env.lookup_constructor lid Env.initial in
-  mkexp (Texp_construct(mknoloc lid, cnone, []))
-    ty loc Env.initial
+  let lid = Longident.Lident "None"
+  and env = Env.initial_safe_string in
+  let cnone = Env.lookup_constructor lid env in
+  mkexp (Texp_construct(mknoloc lid, cnone, [])) ty loc env
 
 let option_some texp =
   let lid = Longident.Lident "Some" in
-  let csome = Env.lookup_constructor lid Env.initial in
+  let csome = Env.lookup_constructor lid Env.initial_safe_string in
   mkexp ( Texp_construct(mknoloc lid , csome, [texp]) )
     (type_option texp.exp_type) texp.exp_loc texp.exp_env
 
@@ -280,8 +281,7 @@ let extract_concrete_record env ty =
 
 let extract_concrete_variant env ty =
   match extract_concrete_typedecl env ty with
-    (* exclude exceptions *)
-    (p0, p, {type_kind=Type_variant (_::_ as cstrs)}) -> (p0, p, cstrs)
+    (p0, p, {type_kind=Type_variant cstrs}) -> (p0, p, cstrs)
   | _ -> raise Not_found
 
 let extract_label_names sexp env ty =
@@ -292,7 +292,11 @@ let extract_label_names sexp env ty =
     assert false
 
 let explicit_arity =
-  List.exists (fun (s, _) -> s.txt = "ocaml.explicit_arity")
+  List.exists
+    (function
+      | ({txt="ocaml.explicit_arity"|"explicit_arity"; _}, _) -> true
+      | _ -> false
+    )
 
 (* Typing of patterns *)
 
@@ -568,7 +572,8 @@ let rec expand_path env p =
     Some {type_manifest = Some ty} ->
       begin match repr ty with
         {desc=Tconstr(p,_,_)} -> expand_path env p
-      | _ -> assert false
+      | _ -> p
+         (* PR#6394: recursive module may introduce incoherent manifest *)
       end
   | _ ->
       let p' = Env.normalize_path None env p in
@@ -1199,8 +1204,10 @@ let rec type_pat ~constrs ~labels ~no_existentials ~mode ~env sp expected_ty =
       unify_pat_types loc !env ty expected_ty;
       { p with pat_extra =
         (Tpat_type (path, lid), loc, sp.ppat_attributes) :: p.pat_extra }
-  | Ppat_extension (s, _arg) ->
-      raise (Error (s.loc, !env, Extension s.txt))
+  | Ppat_exception _ ->
+      raise (Error (loc, !env, Exception_pattern_below_toplevel))
+  | Ppat_extension ext ->
+      raise (Error_forward (Typetexp.error_of_extension ext))
 
 let type_pat ?(allow_existentials=false) ?constrs ?labels
     ?(lev=get_current_level()) env sp expected_ty =
@@ -1373,7 +1380,7 @@ let rec is_nonexpansive exp =
   | Texp_function _ -> true
   | Texp_apply(e, (_,None,_)::el) ->
       is_nonexpansive e && List.for_all is_nonexpansive_opt (List.map snd3 el)
-  | Texp_match(e, cases, _) ->
+  | Texp_match(e, cases, [], _) ->
       is_nonexpansive e &&
       List.for_all
         (fun {c_lhs = _; c_guard; c_rhs} ->
@@ -1409,7 +1416,8 @@ let rec is_nonexpansive exp =
               incr count; true
           | Tcf_initializer e -> is_nonexpansive e
           | Tcf_constraint _ -> true
-          | Tcf_inherit _ -> false)
+          | Tcf_inherit _ -> false
+          | Tcf_attribute _ -> true)
         fields &&
       Vars.fold (fun _ (mut,_,_) b -> decr count; b && mut = Immutable)
         vars true &&
@@ -1429,8 +1437,8 @@ and is_nonexpansive_mod mexp =
   | Tmod_structure str ->
       List.for_all
         (fun item -> match item.str_desc with
-          | Tstr_eval _ | Tstr_primitive _ | Tstr_type _ | Tstr_modtype _
-          | Tstr_open _ | Tstr_class_type _ | Tstr_exn_rebind _ -> true
+          | Tstr_eval _ | Tstr_primitive _ | Tstr_type _
+          | Tstr_modtype _ | Tstr_open _ | Tstr_class_type _  -> true
           | Tstr_value (_, pat_exp_list) ->
               List.for_all (fun vb -> is_nonexpansive vb.vb_expr) pat_exp_list
           | Tstr_module {mb_expr=m;_}
@@ -1438,7 +1446,14 @@ and is_nonexpansive_mod mexp =
           | Tstr_recmodule id_mod_list ->
               List.for_all (fun {mb_expr=m;_} -> is_nonexpansive_mod m)
                 id_mod_list
-          | Tstr_exception _ -> false (* true would be unsound *)
+          | Tstr_exception {ext_kind = Text_decl _} ->
+              false (* true would be unsound *)
+          | Tstr_exception {ext_kind = Text_rebind _} -> true
+          | Tstr_typext te ->
+              List.for_all
+                (function {ext_kind = Text_decl _} -> false
+                        | {ext_kind = Text_rebind _} -> true)
+                te.tyext_constructors
           | Tstr_class _ -> false (* could be more precise *)
           | Tstr_attribute _ -> true
         )
@@ -1449,211 +1464,6 @@ and is_nonexpansive_opt = function
     None -> true
   | Some e -> is_nonexpansive e
 
-(* Typing format strings for printing or reading.
-
-   These format strings are used by functions in modules Printf, Format, and
-   Scanf.
-
-   (Handling of * modifiers contributed by Thorsten Ohl.) *)
-
-external string_to_format :
- string -> ('a, 'b, 'c, 'd, 'e, 'f) format6 = "%identity"
-external format_to_string :
- ('a, 'b, 'c, 'd, 'e, 'f) format6 -> string = "%identity"
-
-let type_format loc fmt =
-
-  let ty_arrow gty ty = newty (Tarrow ("", instance_def gty, ty, Cok)) in
-
-  let bad_conversion fmt i c =
-    raise (Error (loc, Env.empty, Bad_conversion (fmt, i, c))) in
-  let incomplete_format fmt =
-    raise (Error (loc, Env.empty, Incomplete_format fmt)) in
-
-  let rec type_in_format fmt =
-
-    let len = String.length fmt in
-
-    let ty_input = newvar ()
-    and ty_result = newvar ()
-    and ty_aresult = newvar ()
-    and ty_uresult = newvar () in
-
-    let meta = ref 0 in
-
-    let rec scan_format i =
-      if i >= len then
-        if !meta = 0
-        then ty_uresult, ty_result
-        else incomplete_format fmt else
-      match fmt.[i] with
-      | '%' -> scan_opts i (i + 1)
-      | _ -> scan_format (i + 1)
-    and scan_opts i j =
-      if j >= len then incomplete_format fmt else
-      match fmt.[j] with
-      | '_' -> scan_rest true i (j + 1)
-      | _ -> scan_rest false i j
-    and scan_rest skip i j =
-      let rec scan_flags i j =
-        if j >= len then incomplete_format fmt else
-        match fmt.[j] with
-        | '#' | '0' | '-' | ' ' | '+' -> scan_flags i (j + 1)
-        | _ -> scan_width i j
-      and scan_width i j = scan_width_or_prec_value scan_precision i j
-      and scan_decimal_string scan i j =
-        if j >= len then incomplete_format fmt else
-        match fmt.[j] with
-        | '0' .. '9' -> scan_decimal_string scan i (j + 1)
-        | _ -> scan i j
-      and scan_width_or_prec_value scan i j =
-        if j >= len then incomplete_format fmt else
-        match fmt.[j] with
-        | '*' ->
-          let ty_uresult, ty_result = scan i (j + 1) in
-          ty_uresult, ty_arrow Predef.type_int ty_result
-        | '-' | '+' -> scan_decimal_string scan i (j + 1)
-        | _ -> scan_decimal_string scan i j
-      and scan_precision i j =
-        if j >= len then incomplete_format fmt else
-        match fmt.[j] with
-        | '.' -> scan_width_or_prec_value scan_conversion i (j + 1)
-        | _ -> scan_conversion i j
-      and scan_indication j =
-        if j >= len then j - 1 else
-        match fmt.[j] with
-        | '@' ->
-          let k = j + 1 in
-          if k >= len then j - 1 else
-          begin match fmt.[k] with
-          | '%' ->
-            let k = k + 1 in
-            if k >= len then j - 1 else
-            begin match fmt.[k] with
-            | '%' | '@' -> k
-            | _c -> j - 1
-            end
-          | _c -> k
-          end
-        | _c -> j - 1
-      and scan_range j =
-        let rec scan_closing j =
-          if j >= len then incomplete_format fmt else
-          match fmt.[j] with
-          | ']' -> j
-          | '%' ->
-            let j = j + 1 in
-            if j >= len then incomplete_format fmt else
-            begin match fmt.[j] with
-            | '%' | '@' -> scan_closing (j + 1)
-            | c -> bad_conversion fmt j c
-            end
-          | c -> scan_closing (j + 1) in
-        let scan_first_pos j =
-          if j >= len then incomplete_format fmt else
-          match fmt.[j] with
-          | ']' -> scan_closing (j + 1)
-          | c -> scan_closing j in
-        let scan_first_neg j =
-          if j >= len then incomplete_format fmt else
-          match fmt.[j] with
-          | '^' -> scan_first_pos (j + 1)
-          | c -> scan_first_pos j in
-
-        scan_first_neg j
-
-      and conversion j ty_arg =
-        let ty_uresult, ty_result = scan_format (j + 1) in
-        ty_uresult,
-        if skip then ty_result else ty_arrow ty_arg ty_result
-
-      and conversion_a j ty_e ty_arg =
-        let ty_uresult, ty_result = conversion j ty_arg in
-        let ty_a = ty_arrow ty_input (ty_arrow ty_e ty_aresult) in
-        ty_uresult, ty_arrow ty_a ty_result
-
-      and conversion_r j ty_e ty_arg =
-        let ty_uresult, ty_result = conversion j ty_arg in
-        let ty_r = ty_arrow ty_input ty_e in
-        ty_arrow ty_r ty_uresult, ty_result
-
-      and scan_conversion i j =
-        if j >= len then incomplete_format fmt else
-        match fmt.[j] with
-        | '%' | '@' | '!' | ',' -> scan_format (j + 1)
-        | 's' | 'S' ->
-          let j = scan_indication (j + 1) in
-          conversion j Predef.type_string
-        | '[' ->
-          let j = scan_range (j + 1) in
-          let j = scan_indication (j + 1) in
-          conversion j Predef.type_string
-        | 'c' | 'C' -> conversion j Predef.type_char
-        | 'd' | 'i' | 'o' | 'u' | 'x' | 'X' | 'N' ->
-          conversion j Predef.type_int
-        | 'f' | 'e' | 'E' | 'g' | 'G' | 'F' -> conversion j Predef.type_float
-        | 'B' | 'b' -> conversion j Predef.type_bool
-        | 'a' | 'r' as conv ->
-          let conversion =
-            if conv = 'a' then conversion_a else conversion_r in
-          let ty_e = newvar () in
-          let j = j + 1 in
-          if j >= len then conversion (j - 1) ty_e ty_e else begin
-            match fmt.[j] with
-(*            | 'a' | 'A' -> conversion j ty_e (Predef.type_array ty_e)
-            | 'l' | 'L' -> conversion j ty_e (Predef.type_list ty_e)
-            | 'o' | 'O' -> conversion j ty_e (Predef.type_option ty_e)*)
-            | _ -> conversion (j - 1) ty_e ty_e end
-(*        | 'r' ->
-          let ty_e = newvar () in
-          let j = j + 1 in
-          if j >= len then conversion_r (j - 1) ty_e ty_e else begin
-            match fmt.[j] with
-            | 'a' | 'A' -> conversion_r j ty_e (Pref.type_array ty_e)
-            | 'l' | 'L' -> conversion_r j ty_e (Pref.type_list ty_e)
-            | 'o' | 'O' -> conversion_r j ty_e (Pref.type_option ty_e)
-            | _ -> conversion_r (j - 1) ty_e ty_e end *)
-        | 't' -> conversion j (ty_arrow ty_input ty_aresult)
-        | 'l' | 'n' | 'L' as c ->
-          let j = j + 1 in
-          if j >= len then conversion (j - 1) Predef.type_int else begin
-            match fmt.[j] with
-            | 'd' | 'i' | 'o' | 'u' | 'x' | 'X' ->
-              let ty_arg =
-                match c with
-                | 'l' -> Predef.type_int32
-                | 'n' -> Predef.type_nativeint
-                | _ -> Predef.type_int64 in
-              conversion j ty_arg
-            | c -> conversion (j - 1) Predef.type_int
-          end
-        | '{' | '(' as c ->
-          let j = j + 1 in
-          if j >= len then incomplete_format fmt else
-          let sj =
-            Printf.CamlinternalPr.Tformat.sub_format
-              (fun fmt -> incomplete_format (format_to_string fmt))
-              (fun fmt -> bad_conversion (format_to_string fmt))
-              c (string_to_format fmt) j in
-          let sfmt = String.sub fmt j (sj - 2 - j) in
-          let ty_sfmt = type_in_format sfmt in
-          begin match c with
-          | '{' -> conversion (sj - 1) ty_sfmt
-          | _ -> incr meta; conversion (j - 1) ty_sfmt end
-        | ')' when !meta > 0 -> decr meta; scan_format (j + 1)
-        | c -> bad_conversion fmt i c in
-      scan_flags i j in
-
-    let ty_ureader, ty_args = scan_format 0 in
-    newty
-      (Tconstr
-        (Predef.path_format6,
-         [ ty_args; ty_input; ty_aresult;
-           ty_ureader; ty_uresult; ty_result; ],
-         ref Mnil)) in
-
-  type_in_format fmt
-
 (* Approximate the type of an expression, for better recursion *)
 
 let rec approx_type env sty =
@@ -1828,7 +1638,8 @@ let iter_ppat f p =
   | Ppat_or (p1,p2) -> f p1; f p2
   | Ppat_variant (_, arg) | Ppat_construct (_, arg) -> may f arg
   | Ppat_tuple lst ->  List.iter f lst
-  | Ppat_alias (p,_) | Ppat_constraint (p,_) | Ppat_lazy p -> f p
+  | Ppat_exception p | Ppat_alias (p,_)
+  | Ppat_constraint (p,_) | Ppat_lazy p -> f p
   | Ppat_record (args, flag) -> List.iter (fun (_,p) -> f p) args
 
 let contains_polymorphic_variant p =
@@ -1911,9 +1722,10 @@ let rec type_exp env sexp =
 
 and type_expect ?in_function env sexp ty_expected =
   let previous_saved_types = Cmt_format.get_saved_types () in
-  let prev_warnings = Typetexp.warning_attribute sexp.pexp_attributes in
+  Typetexp.warning_enter_scope ();
+  Typetexp.warning_attribute sexp.pexp_attributes;
   let exp = type_expect_ ?in_function env sexp ty_expected in
-  may Warnings.restore prev_warnings;
+  Typetexp.warning_leave_scope ();
   Cmt_format.set_saved_types
     (Cmt_format.Partial_expression exp :: previous_saved_types);
   exp
@@ -1968,24 +1780,32 @@ and type_expect_ ?in_function env sexp ty_expected =
           exp_attributes = sexp.pexp_attributes;
           exp_env = env }
       end
-  | Pexp_constant(Const_string (s, _) as cst) ->
-      let ty_exp = expand_head env ty_expected in
-      let ty =
-        (* Terrible hack for format strings *)
-        match ty_exp.desc with
-          Tconstr(path, _, _) when Path.same path Predef.path_format6 ->
-            if !Clflags.principal && ty_exp.level <> generic_level then
-              Location.prerr_warning loc
-                (Warnings.Not_principal "this coercion to format6");
-            type_format loc s
-        | _ -> instance_def Predef.type_string
-      in
+  | Pexp_constant(Const_string (str, _) as cst) -> (
+    (* Terrible hack for format strings *)
+    let ty_exp = expand_head env ty_expected in
+    let fmt6_path =
+      Path.(Pdot (Pident (Ident.create_persistent "CamlinternalFormatBasics"),
+                  "format6", 0)) in
+    let is_format = match ty_exp.desc with
+      | Tconstr(path, _, _) when Path.same path fmt6_path ->
+        if !Clflags.principal && ty_exp.level <> generic_level then
+          Location.prerr_warning loc
+            (Warnings.Not_principal "this coercion to format6");
+        true
+      | _ -> false
+    in
+    if is_format then
+      let format_parsetree =
+        { (type_format loc str env) with pexp_loc = sexp.pexp_loc }  in
+      type_expect ?in_function env format_parsetree ty_expected
+    else
       rue {
         exp_desc = Texp_constant cst;
         exp_loc = loc; exp_extra = [];
-        exp_type = ty;
+        exp_type = instance_def Predef.type_string;
         exp_attributes = sexp.pexp_attributes;
         exp_env = env }
+  )
   | Pexp_constant cst ->
       rue {
         exp_desc = Texp_constant cst;
@@ -2091,11 +1911,25 @@ and type_expect_ ?in_function env sexp ty_expected =
       end_def ();
       if is_nonexpansive arg then generalize arg.exp_type
       else generalize_expansive env arg.exp_type;
-      let cases, partial =
-        type_cases env arg.exp_type ty_expected true loc caselist
+      let rec split_cases vc ec = function
+        | [] -> List.rev vc, List.rev ec
+        | {pc_lhs = {ppat_desc=Ppat_exception p}} as c :: rest ->
+            split_cases vc ({c with pc_lhs = p} :: ec) rest
+        | c :: rest ->
+            split_cases (c :: vc) ec rest
       in
+      let val_caselist, exn_caselist = split_cases [] [] caselist in
+      if val_caselist = [] && exn_caselist <> [] then
+        raise (Error (loc, env, No_value_clauses));
+      (* Note: val_caselist = [] and exn_caselist = [], i.e. a fully
+         empty pattern matching can be generated by Camlp4 with its
+         revised syntax.  Let's accept it for backward compatibility. *)
+      let val_cases, partial =
+        type_cases env arg.exp_type ty_expected true loc val_caselist in
+      let exn_cases, _ =
+        type_cases env Predef.type_exn ty_expected false loc exn_caselist in
       re {
-        exp_desc = Texp_match(arg, cases, partial);
+        exp_desc = Texp_match(arg, val_cases, exn_cases, partial);
         exp_loc = loc; exp_extra = [];
         exp_type = instance env ty_expected;
         exp_attributes = sexp.pexp_attributes;
@@ -2828,8 +2662,8 @@ and type_expect_ ?in_function env sexp ty_expected =
                      sexp.pexp_attributes) ::
                       exp.exp_extra;
       }
-  | Pexp_extension (s, _arg) ->
-      raise (Error (s.loc, env, Extension s.txt))
+  | Pexp_extension ext ->
+      raise (Error_forward (Typetexp.error_of_extension ext))
 
 and type_function ?in_function loc attrs env ty_expected l caselist =
   let (loc_fun, ty_fun) =
@@ -2901,6 +2735,240 @@ and type_label_access env loc srecord lid =
       (Label.disambiguate lid env opath) labels in
   (record, label, opath)
 
+(* Typing format strings for printing or reading.
+   These formats are used by functions in modules Printf, Format, and Scanf.
+   (Handling of * modifiers contributed by Thorsten Ohl.) *)
+
+and type_format loc str env =
+  let loc = {loc with Location.loc_ghost = true} in
+  try
+    CamlinternalFormatBasics.(CamlinternalFormat.(
+      let mk_exp_loc pexp_desc = {
+        pexp_desc = pexp_desc;
+        pexp_loc = loc;
+        pexp_attributes = [];
+      } and mk_lid_loc lid = {
+        txt = lid;
+        loc = loc;
+      } in
+      let mk_constr name args =
+        let lid = Longident.(Ldot(Lident "CamlinternalFormatBasics", name)) in
+        let arg = match args with
+          | []          -> None
+          | [ e ]       -> Some e
+          | _ :: _ :: _ -> Some (mk_exp_loc (Pexp_tuple args)) in
+        mk_exp_loc (Pexp_construct (mk_lid_loc lid, arg)) in
+      let mk_cst cst = mk_exp_loc (Pexp_constant cst) in
+      let mk_int n = mk_cst (Const_int n)
+      and mk_string str = mk_cst (Const_string (str, None))
+      and mk_char chr = mk_cst (Const_char chr) in
+      let rec mk_formatting_lit fmting = match fmting with
+        | Close_box ->
+          mk_constr "Close_box" []
+        | Close_tag ->
+          mk_constr "Close_tag" []
+        | Break (org, ns, ni) ->
+          mk_constr "Break" [ mk_string org; mk_int ns; mk_int ni ]
+        | FFlush ->
+          mk_constr "FFlush" []
+        | Force_newline ->
+          mk_constr "Force_newline" []
+        | Flush_newline ->
+          mk_constr "Flush_newline" []
+        | Magic_size (org, sz) ->
+          mk_constr "Magic_size" [ mk_string org; mk_int sz ]
+        | Escaped_at ->
+          mk_constr "Escaped_at" []
+        | Escaped_percent ->
+          mk_constr "Escaped_percent" []
+        | Scan_indic c ->
+          mk_constr "Scan_indic" [ mk_char c ]
+      and mk_formatting_gen : type a b c d e f .
+          (a, b, c, d, e, f) formatting_gen -> Parsetree.expression =
+        fun fmting -> match fmting with
+        | Open_tag (Format (fmt', str')) ->
+          mk_constr "Open_tag" [ mk_format fmt' str' ]
+        | Open_box (Format (fmt', str')) ->
+          mk_constr "Open_box" [ mk_format fmt' str' ]
+      and mk_format : type a b c d e f .
+          (a, b, c, d, e, f) CamlinternalFormatBasics.fmt -> string ->
+          Parsetree.expression = fun fmt str ->
+        mk_constr "Format" [ mk_fmt fmt; mk_string str ]
+      and mk_side side = match side with
+        | Left  -> mk_constr "Left"  []
+        | Right -> mk_constr "Right" []
+        | Zeros -> mk_constr "Zeros" []
+      and mk_iconv iconv = match iconv with
+        | Int_d  -> mk_constr "Int_d"  [] | Int_pd -> mk_constr "Int_pd" []
+        | Int_sd -> mk_constr "Int_sd" [] | Int_i  -> mk_constr "Int_i"  []
+        | Int_pi -> mk_constr "Int_pi" [] | Int_si -> mk_constr "Int_si" []
+        | Int_x  -> mk_constr "Int_x"  [] | Int_Cx -> mk_constr "Int_Cx" []
+        | Int_X  -> mk_constr "Int_X"  [] | Int_CX -> mk_constr "Int_CX" []
+        | Int_o  -> mk_constr "Int_o"  [] | Int_Co -> mk_constr "Int_Co" []
+        | Int_u  -> mk_constr "Int_u"  []
+      and mk_fconv fconv = match fconv with
+        | Float_f  -> mk_constr "Float_f"  []
+        | Float_pf -> mk_constr "Float_pf" []
+        | Float_sf -> mk_constr "Float_sf" []
+        | Float_e  -> mk_constr "Float_e"  []
+        | Float_pe -> mk_constr "Float_pe" []
+        | Float_se -> mk_constr "Float_se" []
+        | Float_E  -> mk_constr "Float_E"  []
+        | Float_pE -> mk_constr "Float_pE" []
+        | Float_sE -> mk_constr "Float_sE" []
+        | Float_g  -> mk_constr "Float_g"  []
+        | Float_pg -> mk_constr "Float_pg" []
+        | Float_sg -> mk_constr "Float_sg" []
+        | Float_G  -> mk_constr "Float_G"  []
+        | Float_pG -> mk_constr "Float_pG" []
+        | Float_sG -> mk_constr "Float_sG" []
+        | Float_F  -> mk_constr "Float_F"  []
+      and mk_counter cnt = match cnt with
+        | Line_counter  -> mk_constr "Line_counter"  []
+        | Char_counter  -> mk_constr "Char_counter"  []
+        | Token_counter -> mk_constr "Token_counter" []
+      and mk_int_opt n_opt = match n_opt with
+        | None ->
+          let lid_loc = mk_lid_loc (Longident.Lident "None") in
+          mk_exp_loc (Pexp_construct (lid_loc, None))
+        | Some n ->
+          let lid_loc = mk_lid_loc (Longident.Lident "Some") in
+          mk_exp_loc (Pexp_construct (lid_loc, Some (mk_int n)))
+      and mk_fmtty : type a b c d e f g h i j k l .
+          (a, b, c, d, e, f, g, h, i, j, k, l) fmtty_rel -> Parsetree.expression =
+      fun fmtty -> match fmtty with
+        | Char_ty rest      -> mk_constr "Char_ty"      [ mk_fmtty rest ]
+        | String_ty rest    -> mk_constr "String_ty"    [ mk_fmtty rest ]
+        | Int_ty rest       -> mk_constr "Int_ty"       [ mk_fmtty rest ]
+        | Int32_ty rest     -> mk_constr "Int32_ty"     [ mk_fmtty rest ]
+        | Nativeint_ty rest -> mk_constr "Nativeint_ty" [ mk_fmtty rest ]
+        | Int64_ty rest     -> mk_constr "Int64_ty"     [ mk_fmtty rest ]
+        | Float_ty rest     -> mk_constr "Float_ty"     [ mk_fmtty rest ]
+        | Bool_ty rest      -> mk_constr "Bool_ty"      [ mk_fmtty rest ]
+        | Alpha_ty rest     -> mk_constr "Alpha_ty"     [ mk_fmtty rest ]
+        | Theta_ty rest     -> mk_constr "Theta_ty"     [ mk_fmtty rest ]
+        | Reader_ty rest    -> mk_constr "Reader_ty"    [ mk_fmtty rest ]
+        | Ignored_reader_ty rest ->
+          mk_constr "Ignored_reader_ty" [ mk_fmtty rest ]
+        | Format_arg_ty (sub_fmtty, rest) ->
+          mk_constr "Format_arg_ty" [ mk_fmtty sub_fmtty; mk_fmtty rest ]
+        | Format_subst_ty (sub_fmtty1, sub_fmtty2, rest) ->
+          mk_constr "Format_subst_ty"
+            [ mk_fmtty sub_fmtty1; mk_fmtty sub_fmtty2; mk_fmtty rest ]
+        | End_of_fmtty -> mk_constr "End_of_fmtty" []
+      and mk_ignored : type a b c d e f .
+          (a, b, c, d, e, f) ignored -> Parsetree.expression =
+      fun ign -> match ign with
+        | Ignored_char ->
+          mk_constr "Ignored_char" []
+        | Ignored_caml_char ->
+          mk_constr "Ignored_caml_char" []
+        | Ignored_string pad_opt ->
+          mk_constr "Ignored_string" [ mk_int_opt pad_opt ]
+        | Ignored_caml_string pad_opt ->
+          mk_constr "Ignored_caml_string" [ mk_int_opt pad_opt ]
+        | Ignored_int (iconv, pad_opt) ->
+          mk_constr "Ignored_int" [ mk_iconv iconv; mk_int_opt pad_opt ]
+        | Ignored_int32 (iconv, pad_opt) ->
+          mk_constr "Ignored_int32" [ mk_iconv iconv; mk_int_opt pad_opt ]
+        | Ignored_nativeint (iconv, pad_opt) ->
+          mk_constr "Ignored_nativeint" [ mk_iconv iconv; mk_int_opt pad_opt ]
+        | Ignored_int64 (iconv, pad_opt) ->
+          mk_constr "Ignored_int64" [ mk_iconv iconv; mk_int_opt pad_opt ]
+        | Ignored_float (pad_opt, prec_opt) ->
+          mk_constr "Ignored_float" [ mk_int_opt pad_opt; mk_int_opt prec_opt ]
+        | Ignored_bool ->
+          mk_constr "Ignored_bool" []
+        | Ignored_format_arg (pad_opt, fmtty) ->
+          mk_constr "Ignored_format_arg" [ mk_int_opt pad_opt; mk_fmtty fmtty ]
+        | Ignored_format_subst (pad_opt, fmtty) ->
+          mk_constr "Ignored_format_subst" [
+            mk_int_opt pad_opt; mk_fmtty fmtty ]
+        | Ignored_reader ->
+          mk_constr "Ignored_reader" []
+        | Ignored_scan_char_set (width_opt, char_set) ->
+          mk_constr "Ignored_scan_char_set" [
+            mk_int_opt width_opt; mk_string char_set ]
+        | Ignored_scan_get_counter counter ->
+          mk_constr "Ignored_scan_get_counter" [
+            mk_counter counter
+          ]
+      and mk_padding : type x y . (x, y) padding -> Parsetree.expression =
+      fun pad -> match pad with
+        | No_padding         -> mk_constr "No_padding" []
+        | Lit_padding (s, w) -> mk_constr "Lit_padding" [ mk_side s; mk_int w ]
+        | Arg_padding s      -> mk_constr "Arg_padding" [ mk_side s ]
+      and mk_precision : type x y . (x, y) precision -> Parsetree.expression =
+      fun prec -> match prec with
+        | No_precision    -> mk_constr "No_precision" []
+        | Lit_precision w -> mk_constr "Lit_precision" [ mk_int w ]
+        | Arg_precision   -> mk_constr "Arg_precision" []
+      and mk_fmt : type a b c d e f .
+          (a, b, c, d, e, f) fmt -> Parsetree.expression =
+      fun fmt -> match fmt with
+        | Char rest ->
+          mk_constr "Char" [ mk_fmt rest ]
+        | Caml_char rest ->
+          mk_constr "Caml_char" [ mk_fmt rest ]
+        | String (pad, rest) ->
+          mk_constr "String" [ mk_padding pad; mk_fmt rest ]
+        | Caml_string (pad, rest) ->
+          mk_constr "Caml_string" [ mk_padding pad; mk_fmt rest ]
+        | Int (iconv, pad, prec, rest) ->
+          mk_constr "Int" [
+            mk_iconv iconv; mk_padding pad; mk_precision prec; mk_fmt rest ]
+        | Int32 (iconv, pad, prec, rest) ->
+          mk_constr "Int32" [
+            mk_iconv iconv; mk_padding pad; mk_precision prec; mk_fmt rest ]
+        | Nativeint (iconv, pad, prec, rest) ->
+          mk_constr "Nativeint" [
+            mk_iconv iconv; mk_padding pad; mk_precision prec; mk_fmt rest ]
+        | Int64 (iconv, pad, prec, rest) ->
+          mk_constr "Int64" [
+            mk_iconv iconv; mk_padding pad; mk_precision prec; mk_fmt rest ]
+        | Float (fconv, pad, prec, rest) ->
+          mk_constr "Float" [
+            mk_fconv fconv; mk_padding pad; mk_precision prec; mk_fmt rest ]
+        | Bool rest ->
+          mk_constr "Bool" [ mk_fmt rest ]
+        | Flush rest ->
+          mk_constr "Flush" [ mk_fmt rest ]
+        | String_literal (s, rest) ->
+          mk_constr "String_literal" [ mk_string s; mk_fmt rest ]
+        | Char_literal (c, rest) ->
+          mk_constr "Char_literal" [ mk_char c; mk_fmt rest ]
+        | Format_arg (pad_opt, fmtty, rest) ->
+          mk_constr "Format_arg" [
+            mk_int_opt pad_opt; mk_fmtty fmtty; mk_fmt rest ]
+        | Format_subst (pad_opt, fmtty, rest) ->
+          mk_constr "Format_subst" [
+            mk_int_opt pad_opt; mk_fmtty fmtty; mk_fmt rest ]
+        | Alpha rest ->
+          mk_constr "Alpha" [ mk_fmt rest ]
+        | Theta rest ->
+          mk_constr "Theta" [ mk_fmt rest ]
+        | Formatting_lit (fmting, rest) ->
+          mk_constr "Formatting_lit" [ mk_formatting_lit fmting; mk_fmt rest ]
+        | Formatting_gen (fmting, rest) ->
+          mk_constr "Formatting_gen" [ mk_formatting_gen fmting; mk_fmt rest ]
+        | Reader rest ->
+          mk_constr "Reader" [ mk_fmt rest ]
+        | Scan_char_set (width_opt, char_set, rest) ->
+          mk_constr "Scan_char_set" [
+            mk_int_opt width_opt; mk_string char_set; mk_fmt rest ]
+        | Scan_get_counter (cnt, rest) ->
+          mk_constr "Scan_get_counter" [ mk_counter cnt; mk_fmt rest ]
+        | Ignored_param (ign, rest) ->
+          mk_constr "Ignored_param" [ mk_ignored ign; mk_fmt rest ]
+        | End_of_format ->
+          mk_constr "End_of_format" []
+      in
+      let Fmt_EBB fmt = fmt_ebb_of_string str in
+      mk_constr "Format" [ mk_fmt fmt; mk_string str ]
+    ))
+  with Failure msg ->
+    raise (Error (loc, env, Invalid_format msg))
+
 and type_label_exp create env loc ty_expected
           (lid, label, sarg) =
   (* Here also ty_expected may be at generic_level *)
@@ -3764,12 +3832,8 @@ let report_error env ppf = function
         (function ppf ->
            fprintf ppf "but a %s was expected belonging to the %s type"
              name kind)
-  | Incomplete_format s ->
-      fprintf ppf "Premature end of format string ``%S''" s
-  | Bad_conversion (fmt, i, c) ->
-      fprintf ppf
-        "Bad conversion %%%c, at char number %d \
-         in format string ``%s''" c i fmt
+  | Invalid_format msg ->
+      fprintf ppf "%s" msg
   | Undefined_method (ty, me) ->
       reset_and_mark_loops ty;
       fprintf ppf
@@ -3877,8 +3941,12 @@ let report_error env ppf = function
   | Invalid_for_loop_index ->
       fprintf ppf
         "@[Invalid for-loop index: only variables and _ are allowed.@]"
-  | Extension s ->
-      fprintf ppf "Uninterpreted extension '%s'." s
+  | No_value_clauses ->
+      fprintf ppf
+        "None of the patterns in this 'match' expression match values."
+  | Exception_pattern_below_toplevel ->
+      fprintf ppf
+        "@[Exception patterns must be at the top level of a match case.@]"
 
 let report_error env ppf err =
   wrap_printing_env env (fun () -> report_error env ppf err)
@@ -3888,6 +3956,8 @@ let () =
     (function
       | Error (loc, env, err) ->
         Some (Location.error_of_printer loc (report_error env) err)
+      | Error_forward err ->
+        Some err
       | _ ->
         None
     )
diff --git a/typing/typecore.mli b/typing/typecore.mli
index 8dae2c9883..4ce6b1fc36 100644
--- a/typing/typecore.mli
+++ b/typing/typecore.mli
@@ -79,8 +79,7 @@ type error =
   | Wrong_name of string * type_expr * string * Path.t * Longident.t
   | Name_type_mismatch of
       string * Longident.t * (Path.t * Path.t) * (Path.t * Path.t) list
-  | Incomplete_format of string
-  | Bad_conversion of string * int * char
+  | Invalid_format of string
   | Undefined_method of type_expr * string
   | Undefined_inherited_method of string
   | Virtual_class of Longident.t
@@ -108,9 +107,11 @@ type error =
   | Unqualified_gadt_pattern of Path.t * string
   | Invalid_interval
   | Invalid_for_loop_index
-  | Extension of string
+  | No_value_clauses
+  | Exception_pattern_below_toplevel
 
 exception Error of Location.t * Env.t * error
+exception Error_forward of Location.error
 
 val report_error: Env.t -> formatter -> error -> unit
  (* Deprecated.  Use Location.{error_of_exn, report_error}. *)
diff --git a/typing/typedecl.ml b/typing/typedecl.ml
index 5dcffd1cbe..09fd73f64c 100644
--- a/typing/typedecl.ml
+++ b/typing/typedecl.ml
@@ -33,14 +33,17 @@ type error =
   | Null_arity_external
   | Missing_native_external
   | Unbound_type_var of type_expr * type_declaration
-  | Unbound_exception of Longident.t
-  | Not_an_exception of Longident.t
+  | Not_open_type of Path.t
+  | Not_extensible_type of Path.t
+  | Extension_mismatch of Path.t * Includecore.type_mismatch list
+  | Rebind_wrong_type of Longident.t * Env.t * (type_expr * type_expr) list
+  | Rebind_mismatch of Longident.t * Path.t * Path.t
+  | Rebind_private of Longident.t
   | Bad_variance of int * (bool * bool * bool) * (bool * bool * bool)
   | Unavailable_type_constructor of Path.t
   | Bad_fixed_type of string
-  | Unbound_type_var_exc of type_expr * type_expr
+  | Unbound_type_var_ext of type_expr * extension_constructor
   | Varying_anonymous
-  | Exception_constructor_with_result
 
 open Typedtree
 
@@ -133,45 +136,14 @@ module StringSet =
     let compare (x:t) y = compare x y
   end)
 
-module StringMap =
-  Map.Make(struct
-    type t = string
-    let compare (x:t) y = compare x y
-  end)
-
-let make_params sdecl =
-  try
-    List.map
-      (fun (x, _) ->
-        match x with
-        | None -> Ctype.new_global_var ~name:"_" ()
-        | Some x -> enter_type_variable x)
-      sdecl.ptype_params
-  with Already_bound loc ->
-    raise(Error(loc, Repeated_parameter))
-
-let freevars bound kind =
-  let open Ast_mapper in
-  let vars = ref StringMap.empty in
-  let bound = ref bound in
-  let super = default_mapper in
-  let typ m ct =
-    match ct.ptyp_desc with
-    | Ptyp_var s ->
-        if not (StringSet.mem s !bound) then
-          vars := StringMap.add s ct.ptyp_loc !vars;
-        ct
-    | Ptyp_poly (sl, t) ->
-        let old_bound = !bound in
-        List.iter (fun s -> bound := StringSet.add s !bound) sl;
-        ignore (m.typ m t);
-        bound := old_bound;
-        ct
-    | _ -> super.typ m ct
+let make_params env params =
+  let make_param (sty, v) =
+    try
+      (transl_type_param env sty, v)
+    with Already_bound ->
+      raise(Error(sty.ptyp_loc, Repeated_parameter))
   in
-  let mapper = {super with typ} in
-  ignore (mapper.type_kind mapper kind);
-  StringMap.bindings !vars
+    List.map make_param params
 
 let transl_labels env closed lbls =
   let all_labels = ref StringSet.empty in
@@ -214,11 +186,39 @@ let transl_constructor_arguments env closed ty_name c_name = function
       Types.Cstr_record (id, lbls'),
       Cstr_record lbls
 
+let make_constructor env type_path type_params c_name sargs sret_type =
+  let ty_name = Path.last type_path in
+  match sret_type with
+  | None ->
+      let args, targs =
+        transl_constructor_arguments env true ty_name c_name sargs
+      in
+        targs, None, args, None
+  | Some sret_type ->
+      (* if it's a generalized constructor we must first narrow and
+         then widen so as to not introduce any new constraints *)
+      let z = narrow () in
+      reset_type_variables ();
+      let args, targs =
+        transl_constructor_arguments env false ty_name c_name sargs
+      in
+      let tret_type = transl_simple_type env false sret_type in
+      let ret_type = tret_type.ctyp_type in
+      begin
+        match (Ctype.repr ret_type).desc with
+          Tconstr (p', _, _) when Path.same type_path p' -> ()
+        | _ -> raise (Error (sret_type.ptyp_loc, Constraint_failed
+                              (ret_type, Ctype.newconstr type_path type_params)))
+      end;
+      widen z;
+      targs, Some tret_type, args, Some ret_type
+
 let transl_declaration env sdecl id =
   (* Bind type parameters *)
   reset_type_variables();
   Ctype.begin_def ();
-  let params = make_params sdecl in
+  let tparams = make_params env sdecl.ptype_params in
+  let params = List.map (fun (cty, _) -> cty.ctyp_type) tparams in
   let cstrs = List.map
     (fun (sty, sty', loc) ->
       transl_simple_type env false sty,
@@ -228,61 +228,44 @@ let transl_declaration env sdecl id =
   let (tkind, kind) =
     match sdecl.ptype_kind with
         Ptype_abstract -> Ttype_abstract, Type_abstract
-      | Ptype_variant cstrs ->
+      | Ptype_variant scstrs ->
         let all_constrs = ref StringSet.empty in
         List.iter
           (fun {pcd_name = {txt = name}} ->
             if StringSet.mem name !all_constrs then
               raise(Error(sdecl.ptype_loc, Duplicate_constructor name));
             all_constrs := StringSet.add name !all_constrs)
-          cstrs;
+          scstrs;
         if List.length
-          (List.filter (fun cd -> cd.pcd_args <> Pcstr_tuple []) cstrs)
+          (List.filter (fun cd -> cd.pcd_args <> Pcstr_tuple []) scstrs)
           > (Config.max_tag + 1) then
           raise(Error(sdecl.ptype_loc, Too_many_constructors));
-        let make_cstr {pcd_name = lid; pcd_args; pcd_res = ret_type; pcd_loc = loc; pcd_attributes = attrs} =
-          let name = Ident.create lid.txt in
-          match ret_type with
-            | None ->
-                let args =
-                  transl_constructor_arguments env true (Ident.name id) lid.txt
-                    pcd_args
-                in
-              (name, lid, args, None, None, loc, attrs)
-            | Some sty ->
-              (* if it's a generalized constructor we must first narrow and
-                 then widen so as to not introduce any new constraints *)
-              let z = narrow () in
-              reset_type_variables ();
-              let args =
-                transl_constructor_arguments env false (Ident.name id) lid.txt
-                  pcd_args
-              in
-              let cty = transl_simple_type env false sty in
-              let ret_type =
-                let ty = cty.ctyp_type in
-                let p = Path.Pident id in
-                match (Ctype.repr ty).desc with
-                  Tconstr (p', _, _) when Path.same p p' -> ty
-                | _ ->
-                    raise (Error (sty.ptyp_loc, Constraint_failed
-                                    (ty, Ctype.newconstr p params)))
-              in
-              widen z;
-              (name, lid, args, Some cty, Some ret_type, loc, attrs)
+        let make_cstr scstr =
+          let name = Ident.create scstr.pcd_name.txt in
+          let targs, tret_type, args, ret_type =
+            make_constructor env (Path.Pident id) params
+                             scstr.pcd_name.txt
+                             scstr.pcd_args scstr.pcd_res
+          in
+          let tcstr =
+            { cd_id = name;
+              cd_name = scstr.pcd_name;
+              cd_args = targs;
+              cd_res = tret_type;
+              cd_loc = scstr.pcd_loc;
+              cd_attributes = scstr.pcd_attributes }
+          in
+          let cstr =
+            { Types.cd_id = name;
+              cd_args = args;
+              cd_res = ret_type;
+              cd_loc = scstr.pcd_loc;
+              cd_attributes = scstr.pcd_attributes }
+          in
+            tcstr, cstr
         in
-        let cstrs = List.map make_cstr cstrs in
-        Ttype_variant (List.map (fun (name, lid, (_, args), res, _, loc, attrs) ->
-          {cd_id = name; cd_name = lid; cd_args = args; cd_res = res;
-           cd_loc = loc; cd_attributes = attrs}
-        ) cstrs),
-        Type_variant (List.map (fun (name, name_loc, (args, _), _, option, loc, attrs) ->
-            {Types.cd_id = name; cd_args = args;
-             cd_res = option;
-             cd_loc = loc; cd_attributes = attrs;
-            }
-          ) cstrs)
-
+        let tcstrs, cstrs = List.split (List.map make_cstr scstrs) in
+          Ttype_variant tcstrs, Type_variant cstrs
       | Ptype_record lbls ->
           let lbls, lbls' = transl_labels env true lbls in
           let rep =
@@ -291,6 +274,7 @@ let transl_declaration env sdecl id =
             else Record_regular
           in
           Ttype_record lbls, Type_record(lbls', rep)
+      | Ptype_open -> Ttype_open, Type_open
       in
     let (tman, man) = match sdecl.ptype_manifest with
         None -> None, None
@@ -336,7 +320,7 @@ let transl_declaration env sdecl id =
     {
       typ_id = id;
       typ_name = sdecl.ptype_name;
-      typ_params = sdecl.ptype_params;
+      typ_params = tparams;
       typ_type = decl;
       typ_cstrs = cstrs;
       typ_loc = sdecl.ptype_loc;
@@ -402,7 +386,7 @@ let check_constraints env sdecl (_, decl) =
   | Type_variant l ->
       let find_pl = function
           Ptype_variant pl -> pl
-        | Ptype_record _ | Ptype_abstract -> assert false
+        | Ptype_record _ | Ptype_abstract | Ptype_open -> assert false
       in
       let pl = find_pl sdecl.ptype_kind in
       let pl_index =
@@ -435,10 +419,11 @@ let check_constraints env sdecl (_, decl) =
   | Type_record (l, _) ->
       let find_pl = function
           Ptype_record pl -> pl
-        | Ptype_variant _ | Ptype_abstract -> assert false
+        | Ptype_variant _ | Ptype_abstract | Ptype_open -> assert false
       in
       let pl = find_pl sdecl.ptype_kind in
       check_constraints_labels env visited l pl
+  | Type_open -> ()
   end;
   begin match decl.type_manifest with
   | None -> ()
@@ -456,7 +441,8 @@ let check_constraints env sdecl (_, decl) =
 *)
 let check_coherence env loc id decl =
   match decl with
-    {type_kind = (Type_variant _ | Type_record _); type_manifest = Some ty} ->
+    { type_kind = (Type_variant _ | Type_record _| Type_open);
+      type_manifest = Some ty } ->
       begin match (Ctype.repr ty).desc with
         Tconstr(path, args, _) ->
           begin try
@@ -659,15 +645,6 @@ let make p n i =
   let open Variance in
   set May_pos p (set May_neg n (set May_weak n (set Inj i null)))
 
-let flags (v, i) =
-  let (c, n) =
-    match v with
-    | Covariant -> (true, false)
-    | Contravariant -> (false, true)
-    | Invariant -> (true, true)
-  in
-  (c, n, i)
-
 let compute_variance_type env check (required, loc) decl tyl =
   (* Requirements *)
   let required =
@@ -798,11 +775,17 @@ let compute_variance_gadt env check (required, loc as rloc) decl
             (for_constr tl)
       | _ -> assert false
 
+let compute_variance_extension env check decl ext rloc =
+  compute_variance_gadt env check rloc
+    {decl with type_params = ext.ext_type_params}
+    (ext.ext_args, ext.ext_ret_type)
+
 let compute_variance_decl env check decl (required, loc as rloc) =
-  if decl.type_kind = Type_abstract && decl.type_manifest = None then
+  if (decl.type_kind = Type_abstract || decl.type_kind = Type_open)
+       && decl.type_manifest = None then
     List.map
       (fun (c, n, i) ->
-        make (not n) (not c) (i (*|| decl.type_transparence = Type_new*)))
+        make (not n) (not c) (decl.type_kind <> Type_abstract || i))
       required
   else
   let mn =
@@ -811,7 +794,7 @@ let compute_variance_decl env check decl (required, loc as rloc) =
     | Some ty -> [false, ty]
   in
   match decl.type_kind with
-    Type_abstract ->
+    Type_abstract | Type_open ->
       compute_variance_type env check rloc decl mn
   | Type_variant tll ->
       if List.for_all (fun c -> c.Types.cd_res = None) tll then
@@ -931,7 +914,8 @@ let check_duplicates sdecl_list =
                    ("label", cname.txt, name', sdecl.ptype_name.txt))
             with Not_found -> Hashtbl.add labels cname.txt sdecl.ptype_name.txt)
           fl
-    | Ptype_abstract -> ())
+    | Ptype_abstract -> ()
+    | Ptype_open -> ())
     sdecl_list
 
 (* Force recursion to go through id for private types*)
@@ -1069,105 +1053,234 @@ let transl_type_decl env sdecl_list =
   (* Done *)
   (final_decls, final_env)
 
-(* Translate an exception declaration *)
-let transl_closed_type env sty =
-  let cty = transl_simple_type env true sty in
-  let ty = cty.ctyp_type in
-  let ty =
-  match Ctype.free_variables ty with
-  | []      -> ty
-  | tv :: _ -> raise (Error (sty.ptyp_loc, Unbound_type_var_exc (tv, ty)))
+(* Translating type extensions *)
+
+let transl_extension_constructor env check_open type_path type_params
+                                 typext_params priv sext =
+  let id = Ident.create sext.pext_name.txt in
+  let rebind, args, ret_type, kind =
+    match sext.pext_kind with
+      Pext_decl(sargs, sret_type) ->
+        let targs, tret_type, args, ret_type =
+          make_constructor env type_path typext_params sext.pext_name.txt
+            sargs sret_type
+        in
+          None, args, ret_type, Text_decl(targs, tret_type)
+    | Pext_rebind lid ->
+        let cdescr = Typetexp.find_constructor env sext.pext_loc lid.txt in
+        let usage =
+          if cdescr.cstr_private = Private || priv = Public
+          then Env.Positive else Env.Privatize
+        in
+        Env.mark_constructor usage env (Longident.last lid.txt) cdescr;
+        let (args, cstr_res) = Ctype.instance_constructor cdescr in
+        let res, ret_type =
+          if cdescr.cstr_generalized then
+            let params = Ctype.instance_list env type_params in
+            let res = Ctype.newconstr type_path params in
+            let ret_type = Some (Ctype.newconstr type_path params) in
+              res, ret_type
+          else (Ctype.newconstr type_path typext_params), None
+        in
+        begin
+          try
+            Ctype.unify env cstr_res res
+          with Ctype.Unify trace ->
+            raise (Error(lid.loc,
+                     Rebind_wrong_type(lid.txt, env, trace)))
+        end;
+        (* Remove "_" names from parameters used in the constructor *)
+        if not cdescr.cstr_generalized then begin
+          let vars =
+            Ctype.free_variables (Btype.newgenty (Ttuple args))
+          in
+            List.iter
+              (function {desc = Tvar (Some "_")} as ty ->
+                          if List.memq ty vars then ty.desc <- Tvar None
+                        | _ -> ())
+              typext_params
+        end;
+        (* Ensure that constructor's type matches the type being extended *)
+        let cstr_type_path, cstr_type_params =
+          match cdescr.cstr_res.desc with
+            Tconstr (p, _, _) ->
+              let decl = Env.find_type p env in
+                p, decl.type_params
+          | _ -> assert false
+        in
+        let cstr_types =
+          (Btype.newgenty
+             (Tconstr(cstr_type_path, cstr_type_params, ref Mnil)))
+          :: cstr_type_params
+        in
+        let ext_types =
+          (Btype.newgenty
+             (Tconstr(type_path, type_params, ref Mnil)))
+          :: type_params
+        in
+        if not (Ctype.equal env true cstr_types ext_types) then
+          raise (Error(lid.loc,
+                       Rebind_mismatch(lid.txt, cstr_type_path, type_path)));
+        (* Disallow rebinding private constructors to non-private *)
+        begin
+          match cdescr.cstr_private, priv with
+            Private, Public ->
+              raise (Error(lid.loc, Rebind_private lid.txt))
+          | _ -> ()
+        end;
+        let path =
+          match cdescr.cstr_tag with
+            Cstr_extension(path, _) -> path
+          | _ -> assert false
+        in
+        let rebind, args =
+        if cdescr.cstr_inlined then
+          let p =
+            match cdescr.cstr_args with
+            | [ {desc=Tconstr(p, [], _)} ] -> p
+            | [ {desc=Tconstr(_, _, _)} ] ->
+                (* #5528: TODO *)
+                failwith "Rebinding of inlined extension constructors with free variables is not yet supported."
+            | _ -> assert false
+	  in
+	  let decl =
+	    try Env.find_type p env with Not_found -> assert false
+	  in
+	  let lbls =
+	    match decl.type_kind with Type_record (l, _) -> l | _ -> assert false
+	  in
+	  let id = Ident.create (Path.last type_path ^ "." ^ sext.pext_name.txt) in
+	  Some p, Types.Cstr_record (id, lbls)
+        else
+          None, Types.Cstr_tuple args
+        in
+        rebind, args, ret_type, Text_rebind(path, lid)
   in
-  { cty with ctyp_type = ty }
-
-let transl_exception env excdecl =
-  let loc = excdecl.pcd_loc in
-  let id = Ident.create excdecl.pcd_name.txt in
-  if excdecl.pcd_res <> None then
-    raise (Error (loc, Exception_constructor_with_result));
+  let ext =
+    { ext_type_path = type_path;
+      ext_type_params = typext_params;
+      ext_args = args;
+      ext_ret_type = ret_type;
+      ext_private = priv;
+      Types.ext_loc = sext.pext_loc;
+      Types.ext_attributes = sext.pext_attributes; }
+  in
+  rebind,
+    { ext_id = id;
+      ext_name = sext.pext_name;
+      ext_type = ext;
+      ext_kind = kind;
+      Typedtree.ext_loc = sext.pext_loc;
+      Typedtree.ext_attributes = sext.pext_attributes; }
+
+let transl_type_extension check_open env loc styext =
   reset_type_variables();
   Ctype.begin_def();
-  let exn_args, cd_args =
-    transl_constructor_arguments env true "exn" excdecl.pcd_name.txt
-      excdecl.pcd_args
-  in
-  Ctype.end_def();
-  let cd =
-    { cd_id = id;
-      cd_name = excdecl.pcd_name;
-      cd_args;
-      cd_loc = loc;
-      cd_res = None;
-      cd_attributes = excdecl.pcd_attributes;
-     }
+  let (type_path, type_decl) =
+    Typetexp.find_type env loc styext.ptyext_path.txt
   in
-  begin match exn_args with
-  | Types.Cstr_tuple l -> List.iter Ctype.generalize l
-  | Types.Cstr_record (_,l) ->
-      List.iter (fun l -> Ctype.generalize l.Types.ld_type) l
+  begin
+    match type_decl.type_kind with
+      Type_open -> ()
+    | Type_abstract ->
+        if check_open then begin
+          try
+            let {pext_loc} =
+              List.find (function {pext_kind = Pext_decl _} -> true
+                                | {pext_kind = Pext_rebind _} -> false)
+                        styext.ptyext_constructors
+            in
+              raise (Error(pext_loc, Not_open_type type_path))
+          with Not_found -> ()
+        end
+    | _ -> raise (Error(loc, Not_extensible_type type_path))
   end;
-  let exn_decl =
-    {
-      exn_args;
-      exn_attributes = excdecl.pcd_attributes;
-      Types.exn_loc = loc;
-    }
-  in
-  let newenv = Env.add_exception ~check:true id exn_decl env in
-  cd, exn_decl, newenv
-
-(* Translate an exception rebinding *)
-let transl_exn_rebind env ser =
-  let name = ser.pexrb_name in
-  let lid = ser.pexrb_lid in
-  let cdescr =
-    try
-      Env.lookup_constructor lid.txt env
-    with Not_found ->
-      raise(Error(lid.loc, Unbound_exception lid.txt)) in
-  Env.mark_constructor Env.Positive env (Longident.last lid.txt) cdescr;
-  let path =
-    match cdescr.cstr_tag with
-      Cstr_exception (path, _) -> path
-    | _ -> raise(Error(lid.loc, Not_an_exception lid.txt))
+  let type_variance =
+    List.map (fun v ->
+                let (co, cn) = Variance.get_upper v in
+                  (not cn, not co, false))
+             type_decl.type_variance
   in
-  let exn_args, rebind =
-    if cdescr.cstr_inlined then
-      let p =
-        match cdescr.cstr_args with
-        | [ {desc=Tconstr(p, [], _)} ] -> p
-        | _ -> assert false
-      in
-      let decl =
-        try Env.find_type p env with Not_found -> assert false
-      in
-      let lbls =
-        match decl.type_kind with Type_record (l, _) -> l | _ -> assert false
-      in
-      let id = Ident.create ("exn." ^ name.txt) in
-      Types.Cstr_record (id, lbls), Some p
+  let err =
+    if type_decl.type_arity <> List.length styext.ptyext_params then
+      [Includecore.Arity]
     else
-      Types.Cstr_tuple cdescr.cstr_args, None
+      if List.for_all2
+           (fun (c1, n1, _) (c2, n2, _) -> (not c2 || c1) && (not n2 || n1))
+           type_variance
+           (add_injectivity (List.map snd styext.ptyext_params))
+      then [] else [Includecore.Variance]
   in
-  let exn_decl =
-    {
-     exn_args = exn_args;
-     exn_attributes = [];
-     Types.exn_loc = ser.pexrb_loc;
-    }
+  if err <> [] then
+    raise (Error(loc, Extension_mismatch (type_path, err)));
+  let ttype_params = make_params env styext.ptyext_params in
+  let type_params = List.map (fun (cty, _) -> cty.ctyp_type) ttype_params in
+  List.iter2 (Ctype.unify_var env)
+    (Ctype.instance_list env type_decl.type_params)
+    type_params;
+  let rebind_constructors =
+    List.map (transl_extension_constructor env check_open type_path
+               type_decl.type_params type_params styext.ptyext_private)
+      styext.ptyext_constructors
   in
-  let (id, newenv) = Env.enter_exception ?rebind name.txt exn_decl env in
-  let er =
-    { exrb_id = id;
-      exrb_name = name;
-      exrb_path = path;
-      exrb_txt = lid;
-      exrb_type = exn_decl;
-      exrb_attributes = ser.pexrb_attributes;
-      exrb_loc = ser.pexrb_loc;
-     }
+  let constructors = List.map snd rebind_constructors in
+  Ctype.end_def();
+  (* Generalize types *)
+  List.iter Ctype.generalize type_params;
+  List.iter
+    (fun ext ->
+       Btype.iter_type_expr_cstr_args Ctype.generalize ext.ext_type.ext_args;
+       may Ctype.generalize ext.ext_type.ext_ret_type)
+    constructors;
+  (* Check that all type variable are closed *)
+  List.iter
+    (fun ext ->
+       match Ctype.closed_extension_constructor ext.ext_type with
+         Some ty -> raise(Error(ext.ext_loc, Unbound_type_var_ext(ty, ext.ext_type)))
+       | None -> ())
+    constructors;
+  (* Check variances are correct *)
+  List.iter
+    (fun ext ->
+      ignore (compute_variance_extension env true type_decl
+                ext.ext_type (type_variance, loc)))
+    constructors;
+  (* Add extension constructors to the environment *)
+  let newenv =
+    List.fold_left
+      (fun env (rebind, ext) ->
+         Env.add_extension ?rebind ~check:true ext.ext_id ext.ext_type env)
+      env rebind_constructors
+  in
+  let tyext =
+    { tyext_path = type_path;
+      tyext_txt = styext.ptyext_path;
+      tyext_params = ttype_params;
+      tyext_constructors = constructors;
+      tyext_private = styext.ptyext_private;
+      tyext_attributes = styext.ptyext_attributes; }
   in
-    er, newenv
+    (tyext, newenv)
+
+let transl_exception env sext =
+  reset_type_variables();
+  Ctype.begin_def();
+  let rebind, ext =
+    transl_extension_constructor env false
+      Predef.path_exn [] [] Asttypes.Public sext
+  in
+  Ctype.end_def();
+  (* Generalize types *)
+  Btype.iter_type_expr_cstr_args Ctype.generalize ext.ext_type.ext_args;
+  may Ctype.generalize ext.ext_type.ext_ret_type;
+  (* Check that all type variable are closed *)
+  begin match Ctype.closed_extension_constructor ext.ext_type with
+    Some ty ->
+      raise (Error(ext.ext_loc, Unbound_type_var_ext(ty, ext.ext_type)))
+  | None -> ()
+  end;
+  let newenv = Env.add_extension ?rebind ~check:true ext.ext_id ext.ext_type env in
+    ext, newenv
 
 (* Translate a value declaration *)
 let transl_value_decl env loc valdecl =
@@ -1212,7 +1325,8 @@ let transl_with_constraint env id row_path orig_decl sdecl =
   Env.mark_type_used (Ident.name id) orig_decl;
   reset_type_variables();
   Ctype.begin_def();
-  let params = make_params sdecl in
+  let tparams = make_params env sdecl.ptype_params in
+  let params = List.map (fun (cty, _) -> cty.ctyp_type) tparams in
   let orig_decl = Ctype.instance_declaration orig_decl in
   let arity_ok = List.length params = orig_decl.type_arity in
   if arity_ok then
@@ -1275,7 +1389,7 @@ let transl_with_constraint env id row_path orig_decl sdecl =
   {
     typ_id = id;
     typ_name = sdecl.ptype_name;
-    typ_params = sdecl.ptype_params;
+    typ_params = tparams;
     typ_type = decl;
     typ_cstrs = constraints;
     typ_loc = sdecl.ptype_loc;
@@ -1418,7 +1532,7 @@ let report_error ppf = function
               match c.cd_args with
               | Cstr_tuple tl ->
                   Btype.newgenty (Ttuple tl)
-              | Cstr_record _ -> assert false
+              | Cstr_record _ -> assert false (* #5528: TODO *)
             )
             "case" (fun c -> Ident.name c.Types.cd_id ^ " of ")
       | Type_record (tl, _), _ ->
@@ -1428,14 +1542,48 @@ let report_error ppf = function
           explain_unbound_single ppf ty ty'
       | _ -> ()
       end
-  | Unbound_type_var_exc (tv, ty) ->
-      fprintf ppf "A type variable is unbound in this exception declaration";
-      explain_unbound_single ppf (Ctype.repr tv) ty
-  | Unbound_exception lid ->
-      fprintf ppf "Unbound exception constructor %a" Printtyp.longident lid
-  | Not_an_exception lid ->
-      fprintf ppf "The constructor %a is not an exception"
+  | Unbound_type_var_ext (ty, ext) ->
+      fprintf ppf "A type variable is unbound in this extension constructor";
+      let args = match ext.ext_args with
+        | Cstr_tuple l -> l
+        | Cstr_record _ -> assert false (* #5528: TODO *)
+      in
+      explain_unbound ppf ty args (fun c -> c) "type" (fun _ -> "")
+  | Not_open_type path ->
+      fprintf ppf "@[%s@ %a@]"
+        "Cannot extend type definition"
+        Printtyp.path path
+  | Not_extensible_type path ->
+      fprintf ppf "@[%s@ %a@ %s@]"
+        "Type"
+        Printtyp.path path
+        "is not extensible"
+  | Extension_mismatch (path, errs) ->
+      fprintf ppf "@[<v>@[<hov>%s@ %s@;<1 2>%s@]%a@]"
+        "This extension" "does not match the definition of type"
+        (Path.name path)
+        (Includecore.report_type_mismatch
+           "the type" "this extension" "definition")
+        errs
+  | Rebind_wrong_type (lid, env, trace) ->
+      Printtyp.report_unification_error ppf env trace
+        (function ppf ->
+          fprintf ppf "The constructor %a@ has type"
+            Printtyp.longident lid)
+        (function ppf ->
+           fprintf ppf "but was expected to be of type")
+  | Rebind_mismatch (lid, p, p') ->
+      fprintf ppf
+        "@[%s@ %a@ %s@ %s@ %s@ %s@ %s@]"
+        "The constructor" Printtyp.longident lid
+        "extends type" (Path.name p)
+        "whose declaration does not match"
+        "the declaration of type" (Path.name p')
+  | Rebind_private lid ->
+      fprintf ppf "@[%s@ %a@ %s@]"
+        "The constructor"
         Printtyp.longident lid
+        "is private"
   | Bad_variance (n, v1, v2) ->
       let variance (p,n,i) =
         let inj = if i then "injective " else "" in
@@ -1481,8 +1629,6 @@ let report_error ppf = function
       fprintf ppf "@[%s@ %s@ %s@]"
         "In this GADT definition," "the variance of some parameter"
         "cannot be checked"
-  | Exception_constructor_with_result ->
-      fprintf ppf "Exception constructors cannot specify a result type"
 
 let () =
   Location.register_error_of_exn
diff --git a/typing/typedecl.mli b/typing/typedecl.mli
index bfd186d26c..bb3e3ea583 100644
--- a/typing/typedecl.mli
+++ b/typing/typedecl.mli
@@ -21,11 +21,11 @@ val transl_type_decl:
 
 val transl_exception:
     Env.t ->
-    Parsetree.constructor_declaration ->
-    Typedtree.constructor_declaration * exception_declaration * Env.t
+    Parsetree.extension_constructor -> Typedtree.extension_constructor * Env.t
 
-val transl_exn_rebind:
-    Env.t -> Parsetree.exception_rebind -> Typedtree.exception_rebind * Env.t
+val transl_type_extension:
+    bool -> Env.t -> Location.t -> Parsetree.type_extension ->
+    Typedtree.type_extension * Env.t
 
 val transl_value_decl:
     Env.t -> Location.t ->
@@ -70,14 +70,17 @@ type error =
   | Null_arity_external
   | Missing_native_external
   | Unbound_type_var of type_expr * type_declaration
-  | Unbound_exception of Longident.t
-  | Not_an_exception of Longident.t
+  | Not_open_type of Path.t
+  | Not_extensible_type of Path.t
+  | Extension_mismatch of Path.t * Includecore.type_mismatch list
+  | Rebind_wrong_type of Longident.t * Env.t * (type_expr * type_expr) list
+  | Rebind_mismatch of Longident.t * Path.t * Path.t
+  | Rebind_private of Longident.t
   | Bad_variance of int * (bool*bool*bool) * (bool*bool*bool)
   | Unavailable_type_constructor of Path.t
   | Bad_fixed_type of string
-  | Unbound_type_var_exc of type_expr * type_expr
+  | Unbound_type_var_ext of type_expr * extension_constructor
   | Varying_anonymous
-  | Exception_constructor_with_result
 
 exception Error of Location.t * error
 
diff --git a/typing/typedtree.ml b/typing/typedtree.ml
index 1c41187860..52067415cc 100644
--- a/typing/typedtree.ml
+++ b/typing/typedtree.ml
@@ -76,7 +76,7 @@ and expression_desc =
   | Texp_let of rec_flag * value_binding list * expression
   | Texp_function of label * case list * partial
   | Texp_apply of expression * (label * expression option * optional) list
-  | Texp_match of expression * case list * partial
+  | Texp_match of expression * case list * case list * partial
   | Texp_try of expression * case list
   | Texp_tuple of expression list
   | Texp_construct of
@@ -169,6 +169,7 @@ and class_field_desc =
   | Tcf_method of string loc * private_flag * class_field_kind
   | Tcf_constraint of core_type * core_type
   | Tcf_initializer of expression
+  | Tcf_attribute of attribute
 
 (* Value expressions for the module language *)
 
@@ -210,8 +211,8 @@ and structure_item_desc =
   | Tstr_value of rec_flag * value_binding list
   | Tstr_primitive of value_description
   | Tstr_type of type_declaration list
-  | Tstr_exception of constructor_declaration
-  | Tstr_exn_rebind of exception_rebind
+  | Tstr_typext of type_extension
+  | Tstr_exception of extension_constructor
   | Tstr_module of module_binding
   | Tstr_recmodule of module_binding list
   | Tstr_modtype of module_type_declaration
@@ -276,7 +277,8 @@ and signature_item =
 and signature_item_desc =
     Tsig_value of value_description
   | Tsig_type of type_declaration list
-  | Tsig_exception of constructor_declaration
+  | Tsig_typext of type_extension
+  | Tsig_exception of extension_constructor
   | Tsig_module of module_declaration
   | Tsig_recmodule of module_declaration list
   | Tsig_modtype of module_type_declaration
@@ -346,7 +348,7 @@ and core_type_desc =
   | Ttyp_arrow of label * core_type * core_type
   | Ttyp_tuple of core_type list
   | Ttyp_constr of Path.t * Longident.t loc * core_type list
-  | Ttyp_object of (string * core_type) list * closed_flag
+  | Ttyp_object of (string * attributes * core_type) list * closed_flag
   | Ttyp_class of Path.t * Longident.t loc * core_type list
   | Ttyp_alias of core_type * string
   | Ttyp_variant of row_field list * closed_flag * label list option
@@ -354,14 +356,14 @@ and core_type_desc =
   | Ttyp_package of package_type
 
 and package_type = {
-  pack_name : Path.t;
+  pack_path : Path.t;
   pack_fields : (Longident.t loc * core_type) list;
   pack_type : Types.module_type;
   pack_txt : Longident.t loc;
 }
 
 and row_field =
-    Ttag of label * bool * core_type list
+    Ttag of label * attributes * bool * core_type list
   | Tinherit of core_type
 
 and value_description =
@@ -377,7 +379,7 @@ and value_description =
 and type_declaration =
   { typ_id: Ident.t;
     typ_name: string loc;
-    typ_params: (string loc option * variance) list;
+    typ_params: (core_type * variance) list;
     typ_type: Types.type_declaration;
     typ_cstrs: (core_type * core_type * Location.t) list;
     typ_kind: type_kind;
@@ -391,6 +393,7 @@ and type_kind =
     Ttype_abstract
   | Ttype_variant of constructor_declaration list
   | Ttype_record of label_declaration list
+  | Ttype_open
 
 and label_declaration =
     {
@@ -416,16 +419,29 @@ and constructor_arguments =
   | Cstr_tuple of core_type list
   | Cstr_record of label_declaration list
 
-and exception_rebind =
-    {
-     exrb_id: Ident.t;
-     exrb_name: string loc;
-     exrb_path: Path.t;
-     exrb_txt: Longident.t loc;
-     exrb_type: Types.exception_declaration;
-     exrb_loc: Location.t;
-     exrb_attributes: attribute list;
-    }
+and type_extension =
+  {
+    tyext_path: Path.t;
+    tyext_txt: Longident.t loc;
+    tyext_params: (core_type * variance) list;
+    tyext_constructors: extension_constructor list;
+    tyext_private: private_flag;
+    tyext_attributes: attribute list;
+  }
+
+and extension_constructor =
+  {
+    ext_id: Ident.t;
+    ext_name: string loc;
+    ext_type : Types.extension_constructor;
+    ext_kind : extension_constructor_kind;
+    ext_loc : Location.t;
+    ext_attributes: attribute list;
+  }
+
+and extension_constructor_kind =
+    Text_decl of constructor_arguments * core_type option
+  | Text_rebind of Path.t * Longident.t loc
 
 and class_type =
     {
@@ -458,6 +474,7 @@ and class_type_field_desc =
   | Tctf_val of (string * mutable_flag * virtual_flag * core_type)
   | Tctf_method of (string * private_flag * virtual_flag * core_type)
   | Tctf_constraint of (core_type * core_type)
+  | Tctf_attribute of attribute
 
 and class_declaration =
   class_expr class_infos
@@ -470,7 +487,7 @@ and class_type_declaration =
 
 and 'a class_infos =
   { ci_virt: virtual_flag;
-    ci_params: (string loc * variance) list;
+    ci_params: (core_type * variance) list;
     ci_id_name : string loc;
     ci_id_class: Ident.t;
     ci_id_class_type : Ident.t;
diff --git a/typing/typedtree.mli b/typing/typedtree.mli
index c077c92862..fa36dac8c4 100644
--- a/typing/typedtree.mli
+++ b/typing/typedtree.mli
@@ -75,7 +75,7 @@ and expression_desc =
   | Texp_let of rec_flag * value_binding list * expression
   | Texp_function of label * case list * partial
   | Texp_apply of expression * (label * expression option * optional) list
-  | Texp_match of expression * case list * partial
+  | Texp_match of expression * case list * case list * partial
   | Texp_try of expression * case list
   | Texp_tuple of expression list
   | Texp_construct of
@@ -168,6 +168,7 @@ and class_field_desc =
   | Tcf_method of string loc * private_flag * class_field_kind
   | Tcf_constraint of core_type * core_type
   | Tcf_initializer of expression
+  | Tcf_attribute of attribute
 
 (* Value expressions for the module language *)
 
@@ -209,8 +210,8 @@ and structure_item_desc =
   | Tstr_value of rec_flag * value_binding list
   | Tstr_primitive of value_description
   | Tstr_type of type_declaration list
-  | Tstr_exception of constructor_declaration
-  | Tstr_exn_rebind of exception_rebind
+  | Tstr_typext of type_extension
+  | Tstr_exception of extension_constructor
   | Tstr_module of module_binding
   | Tstr_recmodule of module_binding list
   | Tstr_modtype of module_type_declaration
@@ -275,7 +276,8 @@ and signature_item =
 and signature_item_desc =
     Tsig_value of value_description
   | Tsig_type of type_declaration list
-  | Tsig_exception of constructor_declaration
+  | Tsig_typext of type_extension
+  | Tsig_exception of extension_constructor
   | Tsig_module of module_declaration
   | Tsig_recmodule of module_declaration list
   | Tsig_modtype of module_type_declaration
@@ -345,7 +347,7 @@ and core_type_desc =
   | Ttyp_arrow of label * core_type * core_type
   | Ttyp_tuple of core_type list
   | Ttyp_constr of Path.t * Longident.t loc * core_type list
-  | Ttyp_object of (string * core_type) list * closed_flag
+  | Ttyp_object of (string * attributes * core_type) list * closed_flag
   | Ttyp_class of Path.t * Longident.t loc * core_type list
   | Ttyp_alias of core_type * string
   | Ttyp_variant of row_field list * closed_flag * label list option
@@ -353,14 +355,14 @@ and core_type_desc =
   | Ttyp_package of package_type
 
 and package_type = {
-  pack_name : Path.t;
+  pack_path : Path.t;
   pack_fields : (Longident.t loc * core_type) list;
   pack_type : Types.module_type;
   pack_txt : Longident.t loc;
 }
 
 and row_field =
-    Ttag of label * bool * core_type list
+    Ttag of label * attributes * bool * core_type list
   | Tinherit of core_type
 
 and value_description =
@@ -377,7 +379,7 @@ and type_declaration =
   {
     typ_id: Ident.t;
     typ_name: string loc;
-    typ_params: (string loc option * variance) list;
+    typ_params: (core_type * variance) list;
     typ_type: Types.type_declaration;
     typ_cstrs: (core_type * core_type * Location.t) list;
     typ_kind: type_kind;
@@ -391,6 +393,7 @@ and type_kind =
     Ttype_abstract
   | Ttype_variant of constructor_declaration list
   | Ttype_record of label_declaration list
+  | Ttype_open
 
 and label_declaration =
     {
@@ -416,16 +419,29 @@ and constructor_arguments =
   | Cstr_tuple of core_type list
   | Cstr_record of label_declaration list
 
-and exception_rebind =
-    {
-     exrb_id: Ident.t;
-     exrb_name: string loc;
-     exrb_path: Path.t;
-     exrb_txt: Longident.t loc;
-     exrb_type: Types.exception_declaration;
-     exrb_loc: Location.t;
-     exrb_attributes: attribute list;
-    }
+and type_extension =
+  {
+    tyext_path: Path.t;
+    tyext_txt: Longident.t loc;
+    tyext_params: (core_type * variance) list;
+    tyext_constructors: extension_constructor list;
+    tyext_private: private_flag;
+    tyext_attributes: attributes;
+  }
+
+and extension_constructor =
+  {
+    ext_id: Ident.t;
+    ext_name: string loc;
+    ext_type : Types.extension_constructor;
+    ext_kind : extension_constructor_kind;
+    ext_loc : Location.t;
+    ext_attributes: attributes;
+  }
+
+and extension_constructor_kind =
+    Text_decl of constructor_arguments * core_type option
+  | Text_rebind of Path.t * Longident.t loc
 
 and class_type =
     {
@@ -458,6 +474,7 @@ and class_type_field_desc =
   | Tctf_val of (string * mutable_flag * virtual_flag * core_type)
   | Tctf_method of (string * private_flag * virtual_flag * core_type)
   | Tctf_constraint of (core_type * core_type)
+  | Tctf_attribute of attribute
 
 and class_declaration =
   class_expr class_infos
@@ -470,7 +487,7 @@ and class_type_declaration =
 
 and 'a class_infos =
   { ci_virt: virtual_flag;
-    ci_params: (string loc * variance) list;
+    ci_params: (core_type * variance) list;
     ci_id_name : string loc;
     ci_id_class: Ident.t;
     ci_id_class_type : Ident.t;
diff --git a/typing/typedtreeIter.ml b/typing/typedtreeIter.ml
index b5279fe273..28026b5987 100644
--- a/typing/typedtreeIter.ml
+++ b/typing/typedtreeIter.ml
@@ -24,6 +24,8 @@ module type IteratorArgument = sig
     val enter_structure : structure -> unit
     val enter_value_description : value_description -> unit
     val enter_type_declaration : type_declaration -> unit
+    val enter_type_extension : type_extension -> unit
+    val enter_extension_constructor : extension_constructor -> unit
     val enter_pattern : pattern -> unit
     val enter_expression : expression -> unit
     val enter_package_type : package_type -> unit
@@ -49,6 +51,8 @@ module type IteratorArgument = sig
     val leave_structure : structure -> unit
     val leave_value_description : value_description -> unit
     val leave_type_declaration : type_declaration -> unit
+    val leave_type_extension : type_extension -> unit
+    val leave_extension_constructor : extension_constructor -> unit
     val leave_pattern : pattern -> unit
     val leave_expression : expression -> unit
     val leave_package_type : package_type -> unit
@@ -130,24 +134,18 @@ module MakeIterator(Iter : IteratorArgument) : sig
             iter_bindings rec_flag list
         | Tstr_primitive vd -> iter_value_description vd
         | Tstr_type list -> List.iter iter_type_declaration list
-        | Tstr_exception cd -> iter_constructor_declaration cd
-        | Tstr_exn_rebind _ -> ()
+        | Tstr_typext tyext -> iter_type_extension tyext
+        | Tstr_exception ext -> iter_extension_constructor ext
         | Tstr_module x -> iter_module_binding x
         | Tstr_recmodule list -> List.iter iter_module_binding list
         | Tstr_modtype mtd -> iter_module_type_declaration mtd
         | Tstr_open _ -> ()
         | Tstr_class list ->
-            List.iter (fun (ci, _, _) ->
-                Iter.enter_class_declaration ci;
-                iter_class_expr ci.ci_expr;
-                Iter.leave_class_declaration ci;
-            ) list
+            List.iter (fun (ci, _, _) -> iter_class_declaration ci) list
         | Tstr_class_type list ->
-            List.iter (fun (id, _, ct) ->
-                Iter.enter_class_type_declaration ct;
-                iter_class_type ct.ci_expr;
-                Iter.leave_class_type_declaration ct;
-            ) list
+            List.iter
+              (fun (id, _, ct) -> iter_class_type_declaration ct)
+              list
         | Tstr_include incl -> iter_module_expr incl.incl_mod
         | Tstr_attribute _ ->
             ()
@@ -162,15 +160,20 @@ module MakeIterator(Iter : IteratorArgument) : sig
       iter_core_type v.val_desc;
       Iter.leave_value_description v
 
-    and iter_constructor_declaration cd =
-      begin match cd.cd_args with
+    and iter_constructor_arguments = function
       | Cstr_tuple l -> List.iter iter_core_type l
       | Cstr_record l -> List.iter (fun ld -> iter_core_type ld.ld_type) l
-      end;
+
+    and iter_constructor_declaration cd =
+      iter_constructor_arguments cd.cd_args;
       option iter_core_type cd.cd_res;
 
+    and iter_type_parameter (ct, v) =
+      iter_core_type ct
+
     and iter_type_declaration decl =
       Iter.enter_type_declaration decl;
+      List.iter iter_type_parameter decl.typ_params;
       List.iter (fun (ct1, ct2, loc) ->
           iter_core_type ct1;
           iter_core_type ct2
@@ -184,13 +187,27 @@ module MakeIterator(Iter : IteratorArgument) : sig
               (fun ld ->
                 iter_core_type ld.ld_type
             ) list
+        | Ttype_open -> ()
       end;
-      begin match decl.typ_manifest with
-          None -> ()
-        | Some ct -> iter_core_type ct
-      end;
+      option iter_core_type decl.typ_manifest;
       Iter.leave_type_declaration decl
 
+    and iter_extension_constructor ext =
+      Iter.enter_extension_constructor ext;
+      begin match ext.ext_kind with
+          Text_decl(args, ret) ->
+          iter_constructor_arguments args;
+            option iter_core_type ret
+        | Text_rebind _ -> ()
+      end;
+      Iter.leave_extension_constructor ext;
+
+    and iter_type_extension tyext =
+      Iter.enter_type_extension tyext;
+      List.iter iter_type_parameter tyext.tyext_params;
+      List.iter iter_extension_constructor tyext.tyext_constructors;
+      Iter.leave_type_extension tyext
+
     and iter_pattern pat =
       Iter.enter_pattern pat;
       List.iter (fun (cstr, _, _attrs) -> match cstr with
@@ -250,9 +267,10 @@ module MakeIterator(Iter : IteratorArgument) : sig
                   None -> ()
                 | Some exp -> iter_expression exp
             ) list
-        | Texp_match (exp, list, _) ->
+        | Texp_match (exp, list1, list2, _) ->
             iter_expression exp;
-            iter_cases list
+            iter_cases list1;
+            iter_cases list2;
         | Texp_try (exp, list) ->
             iter_expression exp;
             iter_cases list
@@ -340,8 +358,10 @@ module MakeIterator(Iter : IteratorArgument) : sig
             iter_value_description vd
         | Tsig_type list ->
             List.iter iter_type_declaration list
-        | Tsig_exception cd ->
-            iter_constructor_declaration cd
+        | Tsig_exception ext ->
+            iter_extension_constructor ext
+        | Tsig_typext tyext ->
+            iter_type_extension tyext
         | Tsig_module md ->
             iter_module_type md.md_type
         | Tsig_recmodule list ->
@@ -367,16 +387,23 @@ module MakeIterator(Iter : IteratorArgument) : sig
       end;
       Iter.leave_module_type_declaration mtd
 
+    and iter_class_declaration cd =
+      Iter.enter_class_declaration cd;
+      List.iter iter_type_parameter cd.ci_params;
+      iter_class_expr cd.ci_expr;
+      Iter.leave_class_declaration cd;
 
     and iter_class_description cd =
       Iter.enter_class_description cd;
+      List.iter iter_type_parameter cd.ci_params;
       iter_class_type cd.ci_expr;
       Iter.leave_class_description cd;
 
     and iter_class_type_declaration cd =
       Iter.enter_class_type_declaration cd;
+      List.iter iter_type_parameter cd.ci_params;
       iter_class_type cd.ci_expr;
-        Iter.leave_class_type_declaration cd;
+      Iter.leave_class_type_declaration cd;
 
     and iter_module_type mty =
       Iter.enter_module_type mty;
@@ -497,6 +524,7 @@ module MakeIterator(Iter : IteratorArgument) : sig
         | Tctf_constraint  (ct1, ct2) ->
             iter_core_type ct1;
             iter_core_type ct2
+        | Tctf_attribute _ -> ()
       end;
       Iter.leave_class_type_field ctf
 
@@ -513,7 +541,7 @@ module MakeIterator(Iter : IteratorArgument) : sig
         | Ttyp_constr (path, _, list) ->
             List.iter iter_core_type list
         | Ttyp_object (list, o) ->
-            List.iter (fun (_, t) -> iter_core_type t) list
+            List.iter (fun (_, _, t) -> iter_core_type t) list
         | Ttyp_class (path, _, list) ->
             List.iter iter_core_type list
         | Ttyp_alias (ct, s) ->
@@ -534,7 +562,7 @@ module MakeIterator(Iter : IteratorArgument) : sig
 
     and iter_row_field rf =
       match rf with
-        Ttag (label, bool, list) ->
+        Ttag (label, _attrs, bool, list) ->
           List.iter iter_core_type list
       | Tinherit ct -> iter_core_type ct
 
@@ -557,6 +585,7 @@ module MakeIterator(Iter : IteratorArgument) : sig
           iter_expression exp
       | Tcf_initializer exp ->
           iter_expression exp
+      | Tcf_attribute _ -> ()
       end;
       Iter.leave_class_field cf;
   end
@@ -566,7 +595,8 @@ module DefaultIteratorArgument = struct
       let enter_structure _ = ()
       let enter_value_description _ = ()
       let enter_type_declaration _ = ()
-      let enter_exception_declaration _ = ()
+      let enter_type_extension _ = ()
+      let enter_extension_constructor _ = ()
       let enter_pattern _ = ()
       let enter_expression _ = ()
       let enter_package_type _ = ()
@@ -593,7 +623,8 @@ module DefaultIteratorArgument = struct
       let leave_structure _ = ()
       let leave_value_description _ = ()
       let leave_type_declaration _ = ()
-      let leave_exception_declaration _ = ()
+      let leave_type_extension _ = ()
+      let leave_extension_constructor _ = ()
       let leave_pattern _ = ()
       let leave_expression _ = ()
       let leave_package_type _ = ()
diff --git a/typing/typedtreeIter.mli b/typing/typedtreeIter.mli
index 1582929803..547fc5c34b 100644
--- a/typing/typedtreeIter.mli
+++ b/typing/typedtreeIter.mli
@@ -18,6 +18,8 @@ module type IteratorArgument = sig
     val enter_structure : structure -> unit
     val enter_value_description : value_description -> unit
     val enter_type_declaration : type_declaration -> unit
+    val enter_type_extension : type_extension -> unit
+    val enter_extension_constructor : extension_constructor -> unit
     val enter_pattern : pattern -> unit
     val enter_expression : expression -> unit
     val enter_package_type : package_type -> unit
@@ -43,6 +45,8 @@ module type IteratorArgument = sig
     val leave_structure : structure -> unit
     val leave_value_description : value_description -> unit
     val leave_type_declaration : type_declaration -> unit
+    val leave_type_extension : type_extension -> unit
+    val leave_extension_constructor : extension_constructor -> unit
     val leave_pattern : pattern -> unit
     val leave_expression : expression -> unit
     val leave_package_type : package_type -> unit
diff --git a/typing/typedtreeMap.ml b/typing/typedtreeMap.ml
index c9da597c62..6b28cc8503 100644
--- a/typing/typedtreeMap.ml
+++ b/typing/typedtreeMap.ml
@@ -16,6 +16,9 @@ module type MapArgument = sig
   val enter_structure : structure -> structure
   val enter_value_description : value_description -> value_description
   val enter_type_declaration : type_declaration -> type_declaration
+  val enter_type_extension : type_extension -> type_extension
+  val enter_extension_constructor :
+    extension_constructor -> extension_constructor
   val enter_pattern : pattern -> pattern
   val enter_expression : expression -> expression
   val enter_package_type : package_type -> package_type
@@ -27,10 +30,10 @@ module type MapArgument = sig
   val enter_with_constraint : with_constraint -> with_constraint
   val enter_class_expr : class_expr -> class_expr
   val enter_class_signature : class_signature -> class_signature
+  val enter_class_declaration : class_declaration -> class_declaration
   val enter_class_description : class_description -> class_description
   val enter_class_type_declaration :
     class_type_declaration -> class_type_declaration
-  val enter_class_infos : 'a class_infos -> 'a class_infos
   val enter_class_type : class_type -> class_type
   val enter_class_type_field : class_type_field -> class_type_field
   val enter_core_type : core_type -> core_type
@@ -41,6 +44,9 @@ module type MapArgument = sig
   val leave_structure : structure -> structure
   val leave_value_description : value_description -> value_description
   val leave_type_declaration : type_declaration -> type_declaration
+  val leave_type_extension : type_extension -> type_extension
+  val leave_extension_constructor :
+    extension_constructor -> extension_constructor
   val leave_pattern : pattern -> pattern
   val leave_expression : expression -> expression
   val leave_package_type : package_type -> package_type
@@ -52,10 +58,10 @@ module type MapArgument = sig
   val leave_with_constraint : with_constraint -> with_constraint
   val leave_class_expr : class_expr -> class_expr
   val leave_class_signature : class_signature -> class_signature
+  val leave_class_declaration : class_declaration -> class_declaration
   val leave_class_description : class_description -> class_description
   val leave_class_type_declaration :
     class_type_declaration -> class_type_declaration
-  val leave_class_infos : 'a class_infos -> 'a class_infos
   val leave_class_type : class_type -> class_type
   val leave_class_type_field : class_type_field -> class_type_field
   val leave_core_type : core_type -> core_type
@@ -113,10 +119,10 @@ module MakeMap(Map : MapArgument) = struct
           Tstr_primitive (map_value_description vd)
         | Tstr_type list ->
           Tstr_type (List.map map_type_declaration list)
-        | Tstr_exception cd ->
-          Tstr_exception (map_constructor_declaration cd)
-        | Tstr_exn_rebind er ->
-          Tstr_exn_rebind er
+        | Tstr_typext tyext ->
+          Tstr_typext (map_type_extension tyext)
+        | Tstr_exception ext ->
+          Tstr_exception (map_extension_constructor ext)
         | Tstr_module x ->
           Tstr_module (map_module_binding x)
         | Tstr_recmodule list ->
@@ -127,21 +133,20 @@ module MakeMap(Map : MapArgument) = struct
         | Tstr_open od -> Tstr_open od
         | Tstr_class list ->
           let list =
-            List.map (fun (ci, string_list, virtual_flag) ->
-              let ci = Map.enter_class_infos ci in
-              let ci_expr = map_class_expr ci.ci_expr in
-              (Map.leave_class_infos { ci with ci_expr = ci_expr},
-               string_list, virtual_flag)
-            ) list
+            List.map
+              (fun (ci, string_list, virtual_flag) ->
+                 map_class_declaration ci, string_list, virtual_flag)
+              list
           in
-          Tstr_class list
+            Tstr_class list
         | Tstr_class_type list ->
-          let list = List.map (fun (id, name, ct) ->
-            let ct = Map.enter_class_infos ct in
-            let ci_expr = map_class_type ct.ci_expr in
-            (id, name, Map.leave_class_infos { ct with ci_expr = ci_expr})
-          ) list in
-          Tstr_class_type list
+          let list =
+            List.map
+              (fun (id, name, ct) ->
+               id, name, map_class_type_declaration ct)
+              list
+          in
+            Tstr_class_type list
         | Tstr_include incl ->
           Tstr_include {incl with incl_mod = map_module_expr incl.incl_mod}
         | Tstr_attribute x -> Tstr_attribute x
@@ -158,6 +163,7 @@ module MakeMap(Map : MapArgument) = struct
 
   and map_type_declaration decl =
     let decl = Map.enter_type_declaration decl in
+    let typ_params = List.map map_type_parameter decl.typ_params in
     let typ_cstrs = List.map (fun (ct1, ct2, loc) ->
       (map_core_type ct1,
        map_core_type ct2,
@@ -176,29 +182,48 @@ module MakeMap(Map : MapArgument) = struct
             ) list
         in
         Ttype_record list
+      | Ttype_open -> Ttype_open
     in
-    let typ_manifest =
-      match decl.typ_manifest with
-          None -> None
-        | Some ct -> Some (map_core_type ct)
-    in
-    Map.leave_type_declaration { decl with typ_cstrs = typ_cstrs;
-      typ_kind = typ_kind; typ_manifest = typ_manifest }
+    let typ_manifest = may_map map_core_type decl.typ_manifest in
+    Map.leave_type_declaration { decl with typ_params = typ_params;
+      typ_cstrs = typ_cstrs; typ_kind = typ_kind; typ_manifest = typ_manifest }
+
+  and map_type_parameter (ct, v) = (map_core_type ct, v)
+
+  and map_constructor_arguments = function
+    | Cstr_tuple l ->
+        Cstr_tuple (List.map map_core_type l)
+    | Cstr_record l ->
+        Cstr_record
+          (List.map (fun ld -> {ld with ld_type = map_core_type ld.ld_type})
+             l)
 
   and map_constructor_declaration cd =
-    let cd_args =
-      match cd.cd_args with
-      | Cstr_tuple l ->
-          Cstr_tuple (List.map map_core_type l)
-      | Cstr_record l ->
-          Cstr_record
-            (List.map (fun ld -> {ld with ld_type = map_core_type ld.ld_type})
-               l)
-    in
+    let cd_args = map_constructor_arguments cd.cd_args in
     {cd with cd_args;
      cd_res = may_map map_core_type cd.cd_res
     }
 
+  and map_type_extension tyext =
+    let tyext = Map.enter_type_extension tyext in
+    let tyext_params = List.map map_type_parameter tyext.tyext_params in
+    let tyext_constructors  =
+      List.map map_extension_constructor tyext.tyext_constructors
+    in
+    Map.leave_type_extension { tyext with tyext_params = tyext_params;
+      tyext_constructors = tyext_constructors }
+
+  and map_extension_constructor ext =
+    let ext = Map.enter_extension_constructor ext in
+    let ext_kind = match ext.ext_kind with
+        Text_decl(args, ret) ->
+          let args = map_constructor_arguments args in
+          let ret = may_map map_core_type ret in
+            Text_decl(args, ret)
+      | Text_rebind(p, lid) -> Text_rebind(p, lid)
+    in
+    Map.leave_extension_constructor {ext with ext_kind = ext_kind}
+
   and map_pattern pat =
     let pat = Map.enter_pattern pat in
     let pat_desc =
@@ -258,10 +283,11 @@ module MakeMap(Map : MapArgument) = struct
                         in
                         (label, expo, optional)
                       ) list )
-        | Texp_match (exp, list, partial) ->
+        | Texp_match (exp, list1, list2, partial) ->
           Texp_match (
             map_expression exp,
-            map_cases list,
+            map_cases list1,
+            map_cases list2,
             partial
           )
         | Texp_try (exp, list) ->
@@ -392,8 +418,10 @@ module MakeMap(Map : MapArgument) = struct
           Tsig_value vd ->
             Tsig_value (map_value_description vd)
         | Tsig_type list -> Tsig_type (List.map map_type_declaration list)
-        | Tsig_exception cd ->
-          Tsig_exception (map_constructor_declaration cd)
+        | Tsig_typext tyext ->
+          Tsig_typext (map_type_extension tyext)
+        | Tsig_exception ext ->
+          Tsig_exception (map_extension_constructor ext)
         | Tsig_module md ->
           Tsig_module {md with md_type = map_module_type md.md_type}
         | Tsig_recmodule list ->
@@ -419,16 +447,26 @@ module MakeMap(Map : MapArgument) = struct
     let mtd = {mtd with mtd_type = may_map map_module_type mtd.mtd_type} in
     Map.leave_module_type_declaration mtd
 
+  and map_class_declaration cd =
+    let cd = Map.enter_class_declaration cd in
+    let ci_params = List.map map_type_parameter cd.ci_params in
+    let ci_expr = map_class_expr cd.ci_expr in
+    Map.leave_class_declaration
+      { cd with ci_params = ci_params; ci_expr = ci_expr }
 
   and map_class_description cd =
     let cd = Map.enter_class_description cd in
+    let ci_params = List.map map_type_parameter cd.ci_params in
     let ci_expr = map_class_type cd.ci_expr in
-    Map.leave_class_description { cd with ci_expr = ci_expr}
+    Map.leave_class_description
+      { cd with ci_params = ci_params; ci_expr = ci_expr}
 
   and map_class_type_declaration cd =
     let cd = Map.enter_class_type_declaration cd in
+    let ci_params = List.map map_type_parameter cd.ci_params in
     let ci_expr = map_class_type cd.ci_expr in
-    Map.leave_class_type_declaration { cd with ci_expr = ci_expr }
+    Map.leave_class_type_declaration
+      { cd with ci_params = ci_params; ci_expr = ci_expr }
 
   and map_module_type mty =
     let mty = Map.enter_module_type mty in
@@ -551,6 +589,7 @@ module MakeMap(Map : MapArgument) = struct
           Tctf_method (s, priv, virt, map_core_type ct)
         | Tctf_constraint (ct1, ct2) ->
           Tctf_constraint (map_core_type ct1, map_core_type ct2)
+        | Tctf_attribute _ as x -> x
     in
     Map.leave_class_type_field { ctf with ctf_desc = ctf_desc }
 
@@ -566,7 +605,8 @@ module MakeMap(Map : MapArgument) = struct
         | Ttyp_constr (path, lid, list) ->
           Ttyp_constr (path, lid, List.map map_core_type list)
         | Ttyp_object (list, o) ->
-          Ttyp_object (List.map (fun (s, t) -> (s, map_core_type t)) list, o)
+          Ttyp_object
+            (List.map (fun (s, a, t) -> (s, a, map_core_type t)) list, o)
         | Ttyp_class (path, lid, list) ->
           Ttyp_class (path, lid, List.map map_core_type list)
         | Ttyp_alias (ct, s) -> Ttyp_alias (map_core_type ct, s)
@@ -585,8 +625,8 @@ module MakeMap(Map : MapArgument) = struct
 
   and map_row_field rf =
     match rf with
-        Ttag (label, bool, list) ->
-          Ttag (label, bool, List.map map_core_type list)
+        Ttag (label, attrs, bool, list) ->
+          Ttag (label, attrs, bool, List.map map_core_type list)
       | Tinherit ct -> Tinherit (map_core_type ct)
 
   and map_class_field cf =
@@ -606,6 +646,7 @@ module MakeMap(Map : MapArgument) = struct
         | Tcf_method (lab, priv, Tcfk_concrete (o, exp)) ->
           Tcf_method (lab, priv, Tcfk_concrete (o, map_expression exp))
         | Tcf_initializer exp -> Tcf_initializer (map_expression exp)
+        | Tcf_attribute _ as x -> x
     in
     Map.leave_class_field { cf with cf_desc = cf_desc }
 end
@@ -616,7 +657,8 @@ module DefaultMapArgument = struct
   let enter_structure t = t
   let enter_value_description t = t
   let enter_type_declaration t = t
-  let enter_exception_declaration t = t
+  let enter_type_extension t = t
+  let enter_extension_constructor t = t
   let enter_pattern t = t
   let enter_expression t = t
   let enter_package_type t = t
@@ -628,9 +670,9 @@ module DefaultMapArgument = struct
   let enter_with_constraint t = t
   let enter_class_expr t = t
   let enter_class_signature t = t
+  let enter_class_declaration t = t
   let enter_class_description t = t
   let enter_class_type_declaration t = t
-  let enter_class_infos t = t
   let enter_class_type t = t
   let enter_class_type_field t = t
   let enter_core_type t = t
@@ -642,7 +684,8 @@ module DefaultMapArgument = struct
   let leave_structure t = t
   let leave_value_description t = t
   let leave_type_declaration t = t
-  let leave_exception_declaration t = t
+  let leave_type_extension t = t
+  let leave_extension_constructor t = t
   let leave_pattern t = t
   let leave_expression t = t
   let leave_package_type t = t
@@ -654,9 +697,9 @@ module DefaultMapArgument = struct
   let leave_with_constraint t = t
   let leave_class_expr t = t
   let leave_class_signature t = t
+  let leave_class_declaration t = t
   let leave_class_description t = t
   let leave_class_type_declaration t = t
-  let leave_class_infos t = t
   let leave_class_type t = t
   let leave_class_type_field t = t
   let leave_core_type t = t
diff --git a/typing/typedtreeMap.mli b/typing/typedtreeMap.mli
index 9ee2c8c4a5..5178a51800 100644
--- a/typing/typedtreeMap.mli
+++ b/typing/typedtreeMap.mli
@@ -16,6 +16,9 @@ module type MapArgument = sig
   val enter_structure : structure -> structure
   val enter_value_description : value_description -> value_description
   val enter_type_declaration : type_declaration -> type_declaration
+  val enter_type_extension : type_extension -> type_extension
+  val enter_extension_constructor :
+    extension_constructor -> extension_constructor
   val enter_pattern : pattern -> pattern
   val enter_expression : expression -> expression
   val enter_package_type : package_type -> package_type
@@ -27,10 +30,10 @@ module type MapArgument = sig
   val enter_with_constraint : with_constraint -> with_constraint
   val enter_class_expr : class_expr -> class_expr
   val enter_class_signature : class_signature -> class_signature
+  val enter_class_declaration : class_declaration -> class_declaration
   val enter_class_description : class_description -> class_description
   val enter_class_type_declaration :
     class_type_declaration -> class_type_declaration
-  val enter_class_infos : 'a class_infos -> 'a class_infos
   val enter_class_type : class_type -> class_type
   val enter_class_type_field : class_type_field -> class_type_field
   val enter_core_type : core_type -> core_type
@@ -41,6 +44,9 @@ module type MapArgument = sig
   val leave_structure : structure -> structure
   val leave_value_description : value_description -> value_description
   val leave_type_declaration : type_declaration -> type_declaration
+  val leave_type_extension : type_extension -> type_extension
+  val leave_extension_constructor :
+    extension_constructor -> extension_constructor
   val leave_pattern : pattern -> pattern
   val leave_expression : expression -> expression
   val leave_package_type : package_type -> package_type
@@ -52,10 +58,10 @@ module type MapArgument = sig
   val leave_with_constraint : with_constraint -> with_constraint
   val leave_class_expr : class_expr -> class_expr
   val leave_class_signature : class_signature -> class_signature
+  val leave_class_declaration : class_declaration -> class_declaration
   val leave_class_description : class_description -> class_description
   val leave_class_type_declaration :
     class_type_declaration -> class_type_declaration
-  val leave_class_infos : 'a class_infos -> 'a class_infos
   val leave_class_type : class_type -> class_type
   val leave_class_type_field : class_type_field -> class_type_field
   val leave_core_type : core_type -> core_type
diff --git a/typing/typemod.ml b/typing/typemod.ml
index 418af07f6a..11aeab9321 100644
--- a/typing/typemod.ml
+++ b/typing/typemod.ml
@@ -37,11 +37,11 @@ type error =
   | Not_a_packed_module of type_expr
   | Incomplete_packed_module of type_expr
   | Scoping_pack of Longident.t * type_expr
-  | Extension of string
   | Recursive_module_require_explicit_type
   | Apply_generative
 
 exception Error of Location.t * Env.t * error
+exception Error_forward of Location.error
 
 open Typedtree
 
@@ -68,8 +68,7 @@ let extract_sig_open env loc mty =
 (* Compute the environment after opening a module *)
 
 let type_open_ ?toplevel ovf env loc lid =
-  let path = Typetexp.find_module env lid.loc lid.txt in
-  let md = Env.find_module path env in
+  let path, md = Typetexp.find_module env lid.loc lid.txt in
   let sg = extract_sig_open env lid.loc md.md_type in
   path, Env.open_signature ~loc ?toplevel ovf path sg env
 
@@ -211,8 +210,7 @@ let merge_constraint initial_env loc sg constr =
         make_next_first rs rem
     | (Sig_module(id, md, rs) :: rem, [s], Pwith_module (_, lid))
       when Ident.name id = s ->
-        let path = Typetexp.find_module initial_env loc lid.txt in
-        let md' = Env.find_module path env in
+        let path, md' = Typetexp.find_module initial_env loc lid.txt in
         let md'' = {md' with md_type = Mtype.remove_aliases env md'.md_type} in
         let newmd = Mtype.strengthen_decl env md'' path in
         ignore(Includemod.modtypes env newmd.md_type md.md_type);
@@ -220,8 +218,7 @@ let merge_constraint initial_env loc sg constr =
         Sig_module(id, newmd, rs) :: rem
     | (Sig_module(id, md, rs) :: rem, [s], Pwith_modsubst (_, lid))
       when Ident.name id = s ->
-        let path = Typetexp.find_module initial_env loc lid.txt in
-        let md' = Env.find_module path env in
+        let path, md' = Typetexp.find_module initial_env loc lid.txt in
         let newmd = Mtype.strengthen_decl env md' path in
         ignore(Includemod.modtypes env newmd.md_type md.md_type);
         real_id := Some id;
@@ -250,15 +247,12 @@ let merge_constraint initial_env loc sg constr =
           try match sdecl.ptype_manifest with
           | Some {ptyp_desc = Ptyp_constr (lid, stl)}
             when List.length stl = List.length sdecl.ptype_params ->
-              let params =
-                List.map
-                  (function {ptyp_desc=Ptyp_var s} -> s | _ -> raise Exit)
-                  stl in
-              List.iter2 (fun x (ox, _) ->
-                match ox with
-                    Some y when x = y.txt -> ()
-                  | _ -> raise Exit
-              ) params sdecl.ptype_params;
+              List.iter2 (fun x (y, _) ->
+                match x, y with
+                  {ptyp_desc=Ptyp_var sx}, {ptyp_desc=Ptyp_var sy}
+                    when sx = sy -> ()
+                | _, _ -> raise Exit)
+                stl sdecl.ptype_params;
               lid
           | _ -> raise Exit
           with Exit ->
@@ -272,7 +266,7 @@ let merge_constraint initial_env loc sg constr =
     | [s], Pwith_modsubst (_, lid) ->
         let id =
           match !real_id with None -> assert false | Some id -> id in
-        let path = Typetexp.find_module initial_env loc lid.txt in
+        let path = Typetexp.lookup_module initial_env loc lid.txt in
         let sub = Subst.add_module id path Subst.identity in
         Subst.signature sub sg
     | _ ->
@@ -305,6 +299,12 @@ let rec map_rec'' fn decls rem =
       fn Trec_not d1 :: map_rec'' fn dl rem
   | _ -> map_rec fn decls rem
 
+(* Add type extension flags to extension contructors *)
+let map_ext fn exts rem =
+  match exts with
+  | [] -> rem
+  | d1 :: dl -> fn Text_first d1 :: map_end (fn Text_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
@@ -317,7 +317,7 @@ let rec approx_modtype env smty =
       let (path, info) = Typetexp.find_modtype env smty.pmty_loc lid.txt in
       Mty_ident path
   | Pmty_alias lid ->
-      let path = Typetexp.find_module env smty.pmty_loc lid.txt in
+      let path = Typetexp.lookup_module env smty.pmty_loc lid.txt in
       Mty_alias path
   | Pmty_signature ssg ->
       Mty_signature(approx_sig env ssg)
@@ -332,8 +332,8 @@ let rec approx_modtype env smty =
   | Pmty_typeof smod ->
       let (_, mty) = !type_module_type_of_fwd env smod in
       mty
-  | Pmty_extension (s, _arg) ->
-      raise (Error (s.loc, env, Extension s.txt))
+  | Pmty_extension ext ->
+      raise (Error_forward (Typetexp.error_of_extension ext))
 
 and approx_module_declaration env pmd =
   {
@@ -434,10 +434,10 @@ let check cl loc set_ref name =
 let check_name cl set_ref name =
   check cl name.loc set_ref name.txt
 
-let check_exn_decl loc type_names decl =
+let check_ext_decl loc type_names decl =
   List.iter
     (fun id -> check "type" loc type_names (Ident.name id))
-    (Subst.sub_ids_exn decl)
+    (Subst.sub_ids_ext decl)
 
 let check_sig_item type_names module_names modtype_names loc = function
     Sig_type(id, _, _) ->
@@ -446,30 +446,29 @@ let check_sig_item type_names module_names modtype_names loc = function
       check "module" loc module_names (Ident.name id)
   | Sig_modtype(id, _) ->
       check "module type" loc modtype_names (Ident.name id)
-  | Sig_exception(_, decl) ->
-      check_exn_decl loc type_names decl
+  | Sig_typext(_, ext, _) ->
+      check_ext_decl loc type_names ext
   | _ -> ()
 
-let rec remove_duplicates val_ids exn_ids  = function
+let rec remove_duplicates val_ids ext_ids = function
     [] -> []
   | Sig_value (id, _) :: rem
     when List.exists (Ident.equal id) val_ids ->
-      remove_duplicates val_ids exn_ids rem
-  | Sig_exception(id, decl) :: rem
-    when List.exists (Ident.equal id) exn_ids && Subst.sub_ids_exn decl = [] ->
-      remove_duplicates val_ids exn_ids rem
-  | f :: rem -> f :: remove_duplicates val_ids exn_ids rem
+      remove_duplicates val_ids ext_ids rem
+  | Sig_typext (id, decl, _) :: rem
+    when List.exists (Ident.equal id) ext_ids && Subst.sub_ids_ext decl = [] ->
+      remove_duplicates val_ids ext_ids rem
+  | f :: rem -> f :: remove_duplicates val_ids ext_ids rem
 
 let rec get_values = function
     [] -> []
   | Sig_value (id, _) :: rem -> id :: get_values rem
   | f :: rem -> get_values rem
 
-let rec get_exceptions = function
+let rec get_extension_constructors = function
     [] -> []
-  | Sig_exception (id, decl) :: rem -> id :: get_exceptions rem
-  | f :: rem -> get_exceptions rem
-
+  | Sig_typext (id, _, _) :: rem -> id :: get_extension_constructors rem
+  | f :: rem -> get_extension_constructors rem
 
 (* Check and translate a module type expression *)
 
@@ -478,7 +477,7 @@ let transl_modtype_longident loc env lid =
   path
 
 let transl_module_alias loc env lid =
-  Typetexp.find_module env loc lid
+  Typetexp.lookup_module env loc lid
 
 let mkmty desc typ env loc attrs =
   let mty = {
@@ -546,8 +545,8 @@ let rec transl_modtype env smty =
   | Pmty_typeof smod ->
       let tmty, mty = !type_module_type_of_fwd env smod in
       mkmty (Tmty_typeof tmty) mty env loc smty.pmty_attributes
-  | Pmty_extension (s, _arg) ->
-      raise (Error (s.loc, env, Extension s.txt))
+  | Pmty_extension ext ->
+      raise (Error_forward (Typetexp.error_of_extension ext))
 
 and transl_signature env sg =
   let type_names = ref StringSet.empty
@@ -578,16 +577,42 @@ and transl_signature env sg =
             mksig (Tsig_type decls) env loc :: trem,
             prepend_sig_types decls rem,
             final_env
-        | Psig_exception sarg ->
-            let (arg, decl, newenv) = Typedecl.transl_exception env sarg in
-            check_exn_decl sarg.pcd_name.loc type_names decl;
+        | Psig_typext styext ->
+            let (tyext, newenv) =
+              Typedecl.transl_type_extension false env item.psig_loc styext
+            in
+            List.iter
+              (fun ext ->
+                 check_ext_decl ext.ext_loc type_names ext.ext_type
+              )
+              tyext.tyext_constructors;
+            let (trem, rem, final_env) = transl_sig newenv srem in
+            let constructors =
+              List.filter
+                (fun ext -> not
+                  (List.exists (Ident.equal ext.ext_id)
+                               (get_extension_constructors rem))
+                   && Subst.sub_ids_ext ext.ext_type = []
+                )
+                tyext.tyext_constructors
+            in
+              mksig (Tsig_typext tyext) env loc :: trem,
+              map_ext (fun es ext ->
+                Sig_typext(ext.ext_id, ext.ext_type, es)) constructors rem,
+              final_env
+        | Psig_exception sext ->
+            let (ext, newenv) = Typedecl.transl_exception env sext in
+            check_ext_decl ext.ext_loc type_names ext.ext_type;
             let (trem, rem, final_env) = transl_sig newenv srem in
-            let id = arg.cd_id in
-            let trem = mksig (Tsig_exception arg) env loc :: trem in
-            trem,
-            (if List.exists (Ident.equal id) (get_exceptions rem)
-                && Subst.sub_ids_exn decl = [] then rem
-             else Sig_exception(id, decl) :: rem),
+            let shadowed =
+              List.exists
+                (Ident.equal ext.ext_id)
+                (get_extension_constructors rem)
+                && Subst.sub_ids_ext ext.ext_type = []
+            in
+            mksig (Tsig_exception ext) env loc :: trem,
+            (if shadowed then rem else
+               Sig_typext(ext.ext_id, ext.ext_type, Text_exception) :: rem),
             final_env
         | Psig_module pmd ->
             check_name "module" module_names pmd.pmd_name;
@@ -656,7 +681,8 @@ and transl_signature env sg =
             in
             let (trem, rem, final_env) = transl_sig newenv srem in
             mksig (Tsig_include incl) env loc :: trem,
-            remove_duplicates (get_values rem) (get_exceptions rem) sg @ rem,
+            remove_duplicates (get_values rem)
+              (get_extension_constructors rem) sg @ rem,
             final_env
         | Psig_class cl ->
             List.iter
@@ -699,15 +725,17 @@ and transl_signature env sg =
                  classes [rem]),
             final_env
         | Psig_attribute x ->
-            let _back = Typetexp.warning_attribute [x] in
+            Typetexp.warning_attribute [x];
             let (trem,rem, final_env) = transl_sig env srem in
             mksig (Tsig_attribute x) env loc :: trem, rem, final_env
-        | Psig_extension ((s, _), _) ->
-            raise (Error (s.loc, env, Extension s.txt))
+        | Psig_extension (ext, _attrs) ->
+            raise (Error_forward (Typetexp.error_of_extension ext))
   in
   let previous_saved_types = Cmt_format.get_saved_types () in
+  Typetexp.warning_enter_scope ();
   let (trem, rem, final_env) = transl_sig (Env.in_signature env) sg in
   let sg = { sig_items = trem; sig_type =  rem; sig_final_env = final_env } in
+  Typetexp.warning_leave_scope ();
   Cmt_format.set_saved_types
     ((Cmt_format.Partial_signature sg) :: previous_saved_types);
   sg
@@ -1019,7 +1047,8 @@ let wrap_constraint env arg mty explicit =
 let rec type_module ?(alias=false) sttn funct_body anchor env smod =
   match smod.pmod_desc with
     Pmod_ident lid ->
-      let path = Typetexp.find_module env smod.pmod_loc lid.txt in
+      let path =
+        Typetexp.lookup_module ~load:(not alias) env smod.pmod_loc lid.txt in
       let md = { mod_desc = Tmod_ident (path, lid);
                  mod_type = Mty_alias path;
                  mod_env = env;
@@ -1144,8 +1173,8 @@ let rec type_module ?(alias=false) sttn funct_body anchor env smod =
            mod_env = env;
            mod_attributes = smod.pmod_attributes;
            mod_loc = smod.pmod_loc }
-  | Pmod_extension (s, _arg) ->
-      raise (Error (s.loc, env, Extension s.txt))
+  | Pmod_extension ext ->
+      raise (Error_forward (Typetexp.error_of_extension ext))
 
 and type_structure ?(toplevel = false) funct_body anchor env sstr scope =
   let type_names = ref StringSet.empty
@@ -1190,17 +1219,25 @@ and type_structure ?(toplevel = false) funct_body anchor env sstr scope =
         Tstr_type decls,
         prepend_sig_types decls [],
         enrich_type_decls anchor decls env newenv
-    | Pstr_exception sarg ->
-        let (arg, decl, newenv) = Typedecl.transl_exception env sarg in
-        check_exn_decl sarg.pcd_name.loc type_names decl;
-        Tstr_exception arg,
-        [Sig_exception(arg.cd_id, decl)],
-        newenv
-    | Pstr_exn_rebind ser ->
-        let (er, newenv) = Typedecl.transl_exn_rebind env ser in
-        check_exn_decl ser.pexrb_name.loc type_names er.exrb_type;
-        Tstr_exn_rebind er,
-        [Sig_exception(er.exrb_id, er.exrb_type)],
+    | Pstr_typext styext ->
+        let (tyext, newenv) =
+          Typedecl.transl_type_extension true env loc styext
+        in
+        List.iter
+          (fun ext ->
+             check_ext_decl ext.ext_loc type_names ext.ext_type
+          )
+          tyext.tyext_constructors;
+        (Tstr_typext tyext,
+         map_ext
+           (fun es ext -> Sig_typext(ext.ext_id, ext.ext_type, es))
+           tyext.tyext_constructors [],
+         newenv)
+    | Pstr_exception sext ->
+        let (ext, newenv) = Typedecl.transl_exception env sext in
+        check_ext_decl ext.ext_loc type_names ext.ext_type;
+        Tstr_exception ext,
+        [Sig_typext(ext.ext_id, ext.ext_type, Text_exception)],
         newenv
     | Pstr_module {pmb_name = name; pmb_expr = smodl; pmb_attributes = attrs;
                    pmb_loc;
@@ -1352,8 +1389,8 @@ and type_structure ?(toplevel = false) funct_body anchor env sstr scope =
                       Sig_module (id, {md with md_type =
                                        Mty_alias (Pdot(p,Ident.name id,n))},
                                   rs)
-                  | Sig_value (_, {val_kind=Val_reg}) | Sig_exception _
-                  | Sig_class _ as it ->
+                  | Sig_value (_, {val_kind=Val_reg})
+                  | Sig_typext _ | Sig_class _ as it ->
                       incr pos; it
                   | Sig_value _ | Sig_type _ | Sig_modtype _
                   | Sig_class_type _ as it ->
@@ -1372,10 +1409,10 @@ and type_structure ?(toplevel = false) funct_body anchor env sstr scope =
           }
         in
         Tstr_include incl, sg, new_env
-    | Pstr_extension ((s, _), _) ->
-        raise (Error (s.loc, env, Extension s.txt))
+    | Pstr_extension (ext, _attrs) ->
+        raise (Error_forward (Typetexp.error_of_extension ext))
     | Pstr_attribute x ->
-        let _back = Typetexp.warning_attribute [x] in
+        Typetexp.warning_attribute [x];
         Tstr_attribute x, [], env
   in
   let rec type_struct env sstr =
@@ -1395,8 +1432,10 @@ and type_structure ?(toplevel = false) funct_body anchor env sstr scope =
     (* moved to genannot *)
     List.iter (function {pstr_loc = l} -> Stypes.record_phrase l) sstr;
   let previous_saved_types = Cmt_format.get_saved_types () in
+  Typetexp.warning_enter_scope ();
   let (items, sg, final_env) = type_struct env sstr in
   let str = { str_items = items; str_type = sg; str_final_env = final_env } in
+  Typetexp.warning_leave_scope ();
   Cmt_format.set_saved_types
     (Cmt_format.Partial_structure str :: previous_saved_types);
   str, sg, final_env
@@ -1423,7 +1462,7 @@ and normalize_signature_item env = function
   | Sig_module(id, md, _) -> normalize_modtype env md.md_type
   | _ -> ()
 
-(* Simplify multiple specifications of a value or an exception in a signature.
+(* Simplify multiple specifications of a value or an extension in a signature.
    (Other signature components, e.g. types, modules, etc, are checked for
    name uniqueness.)  If multiple specifications with the same name,
    keep only the last (rightmost) one. *)
@@ -1436,25 +1475,24 @@ let rec simplify_modtype mty =
   | Mty_signature sg -> Mty_signature(simplify_signature sg)
 
 and simplify_signature sg =
-  let rec simplif val_names exn_names res = function
+  let rec simplif val_names ext_names res = function
     [] -> res
   | (Sig_value(id, descr) as component) :: sg ->
       let name = Ident.name id in
-      simplif (StringSet.add name val_names) exn_names
+      simplif (StringSet.add name val_names) ext_names
               (if StringSet.mem name val_names then res else component :: res)
               sg
-  | (Sig_exception(id, decl) as component) :: sg ->
+  | (Sig_typext(id, ext, es) as component) :: sg ->
       let name = Ident.name id in
-      simplif val_names (StringSet.add name exn_names)
-              (if StringSet.mem name exn_names && Subst.sub_ids_exn decl = []
+      simplif val_names (StringSet.add name ext_names)
+              (if StringSet.mem name ext_names && Subst.sub_ids_ext ext = []
                then res else component :: res)
               sg
   | Sig_module(id, md, rs) :: sg ->
       let md = {md with md_type = simplify_modtype md.md_type} in
-      simplif val_names exn_names
-              (Sig_module(id, md, rs) :: res) sg
+      simplif val_names ext_names (Sig_module(id, md, rs) :: res) sg
   | component :: sg ->
-      simplif val_names exn_names (component :: res) sg
+      simplif val_names ext_names (component :: res) sg
   in
     simplif StringSet.empty StringSet.empty [] (List.rev sg)
 
@@ -1464,8 +1502,7 @@ let type_module_type_of env smod =
   let tmty =
     match smod.pmod_desc with
     | Pmod_ident lid -> (* turn off strengthening in this case *)
-        let path = Typetexp.find_module env smod.pmod_loc lid.txt in
-        let md = Env.find_module path env in
+        let path, md = Typetexp.find_module env smod.pmod_loc lid.txt in
         rm { mod_desc = Tmod_ident (path, lid);
              mod_type = md.md_type;
              mod_env = env;
@@ -1538,6 +1575,7 @@ let () =
   Typecore.type_package := type_package;
   type_module_type_of_fwd := type_module_type_of
 
+
 (* Typecheck an implementation file *)
 
 let type_implementation sourcefile outputprefix modulename initial_env ast =
@@ -1545,6 +1583,11 @@ let type_implementation sourcefile outputprefix modulename initial_env ast =
   try
   Typecore.reset_delayed_checks ();
   Env.reset_required_globals ();
+  begin
+    let map = Typetexp.emit_external_warnings in
+    ignore (map.Ast_mapper.structure map ast)
+  end;
+
   let (str, sg, finalenv) =
     type_structure initial_env ast (Location.in_file sourcefile) in
   let simple_sg = simplify_signature sg in
@@ -1563,7 +1606,8 @@ let type_implementation sourcefile outputprefix modulename initial_env ast =
           raise(Error(Location.in_file sourcefile, Env.empty,
                       Interface_not_compiled sourceintf)) in
       let dclsig = Env.read_signature modulename intf_file in
-      let coercion = Includemod.compunit sourcefile sg intf_file dclsig in
+      let coercion =
+        Includemod.compunit initial_env sourcefile sg intf_file dclsig in
       Typecore.force_delayed_checks ();
       (* It is important to run these checks after the inclusion test above,
          so that value declarations which are not used internally but exported
@@ -1575,7 +1619,7 @@ let type_implementation sourcefile outputprefix modulename initial_env ast =
       check_nongen_schemes finalenv str.str_items;
       normalize_signature finalenv simple_sg;
       let coercion =
-        Includemod.compunit sourcefile sg
+        Includemod.compunit initial_env sourcefile sg
                             "(inferred signature)" simple_sg in
       Typecore.force_delayed_checks ();
       (* See comment above. Here the target signature contains all
@@ -1604,6 +1648,13 @@ let save_signature modname tsg outputprefix source_file initial_env cmi =
   Cmt_format.save_cmt  (outputprefix ^ ".cmti") modname
     (Cmt_format.Interface tsg) (Some source_file) initial_env (Some cmi)
 
+let type_interface env ast =
+  begin
+    let map = Typetexp.emit_external_warnings in
+    ignore (map.Ast_mapper.signature map ast)
+  end;
+  transl_signature env ast
+
 (* "Packaging" of several compilation units into one unit
    having them as sub-modules.  *)
 
@@ -1620,7 +1671,7 @@ let rec package_signatures subst = function
                  Trec_not) ::
       package_signatures (Subst.add_module oldid (Pident newid) subst) rem
 
-let package_units objfiles cmifile modulename =
+let package_units initial_env objfiles cmifile modulename =
   (* Read the signatures of the units *)
   let units =
     List.map
@@ -1629,7 +1680,7 @@ let package_units objfiles cmifile modulename =
          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)
+            not(Mtype.no_code_needed_sig Env.initial_safe_string sg)
          then raise(Error(Location.none, Env.empty,
                           Implementation_is_required f));
          (modname, Env.read_signature modname (pref ^ ".cmi")))
@@ -1647,22 +1698,22 @@ let package_units objfiles cmifile modulename =
     end;
     let dclsig = Env.read_signature modulename cmifile in
     Cmt_format.save_cmt  (prefix ^ ".cmt") modulename
-      (Cmt_format.Packed (sg, objfiles)) None Env.initial None ;
-    Includemod.compunit "(obtained by packing)" sg mlifile dclsig
+      (Cmt_format.Packed (sg, objfiles)) None initial_env  None ;
+    Includemod.compunit initial_env "(obtained by packing)" sg mlifile dclsig
   end else begin
     (* Determine imports *)
     let unit_names = List.map fst units in
     let imports =
       List.filter
         (fun (name, crc) -> not (List.mem name unit_names))
-        (Env.imported_units()) in
+        (Env.imports()) in
     (* Write packaged signature *)
     if not !Clflags.dont_write_files then begin
       let sg =
         Env.save_signature_with_imports sg modulename
           (prefix ^ ".cmi") imports in
       Cmt_format.save_cmt (prefix ^ ".cmt")  modulename
-        (Cmt_format.Packed (sg, objfiles)) None Env.initial (Some sg)
+        (Cmt_format.Packed (sg, objfiles)) None initial_env (Some sg)
     end;
     Tcoerce_none
   end
@@ -1745,8 +1796,6 @@ let report_error ppf = function
         "The type %a in this module cannot be exported.@ " longident lid;
       fprintf ppf
         "Its type contains local dependencies:@ %a" type_expr ty
-  | Extension s ->
-      fprintf ppf "Uninterpreted extension '%s'." s
   | Recursive_module_require_explicit_type ->
       fprintf ppf "Recursive modules require an explicit module type."
   | Apply_generative ->
@@ -1760,6 +1809,8 @@ let () =
     (function
       | Error (loc, env, err) ->
         Some (Location.error_of_printer loc (report_error env) err)
+      | Error_forward err ->
+        Some err
       | _ ->
         None
     )
diff --git a/typing/typemod.mli b/typing/typemod.mli
index 051a283609..8895017885 100644
--- a/typing/typemod.mli
+++ b/typing/typemod.mli
@@ -26,18 +26,24 @@ val type_toplevel_phrase:
 val type_implementation:
   string -> string -> string -> Env.t -> Parsetree.structure ->
   Typedtree.structure * Typedtree.module_coercion
+val type_interface:
+        Env.t -> Parsetree.signature -> Typedtree.signature
 val transl_signature:
         Env.t -> Parsetree.signature -> Typedtree.signature
 val check_nongen_schemes:
         Env.t -> Typedtree.structure_item list -> unit
+val type_open_:
+        ?toplevel:bool -> Asttypes.override_flag ->
+        Env.t -> Location.t -> Longident.t Asttypes.loc -> Path.t * Env.t
 
 val simplify_signature: signature -> signature
 
-val save_signature : string -> Typedtree.signature -> string -> string ->
+val save_signature:
+  string -> Typedtree.signature -> string -> string ->
   Env.t -> Types.signature_item list -> unit
 
 val package_units:
-        string list -> string -> string -> Typedtree.module_coercion
+  Env.t -> string list -> string -> string -> Typedtree.module_coercion
 
 type error =
     Cannot_apply of module_type
@@ -58,10 +64,10 @@ type error =
   | Not_a_packed_module of type_expr
   | Incomplete_packed_module of type_expr
   | Scoping_pack of Longident.t * type_expr
-  | Extension of string
   | Recursive_module_require_explicit_type
   | Apply_generative
 
 exception Error of Location.t * Env.t * error
+exception Error_forward of Location.error
 
 val report_error: Env.t -> formatter -> error -> unit
diff --git a/typing/types.ml b/typing/types.ml
index 57328026d1..2b3f26ce6f 100644
--- a/typing/types.ml
+++ b/typing/types.ml
@@ -125,7 +125,8 @@ type constructor_description =
 and constructor_tag =
     Cstr_constant of int                (* Constant constructor (an int) *)
   | Cstr_block of int                   (* Regular constructor (a block) *)
-  | Cstr_exception of Path.t * Location.t (* Exception constructor *)
+  | Cstr_extension of Path.t * bool     (* Extension constructor
+                                           true if a constant false if a block *)
 
 (* Record label descriptions *)
 
@@ -146,7 +147,7 @@ and record_representation =
     Record_regular                      (* All fields are boxed / tagged *)
   | Record_inlined of int               (* Same, for inlined records *)
   | Record_float                        (* All fields are floats *)
-  | Record_exception of Path.t          (* Inlined record under exception *)
+  | Record_extension of Path.t          (* Inlined record under exception *)
 
 (* Variance *)
 
@@ -196,6 +197,7 @@ and type_kind =
     Type_abstract
   | Type_record of label_declaration list  * record_representation
   | Type_variant of constructor_declaration list
+  | Type_open
 
 and label_declaration =
   {
@@ -219,17 +221,20 @@ and constructor_arguments =
   | Cstr_tuple of type_expr list
   | Cstr_record of Ident.t * label_declaration list
 
+type extension_constructor =
+    { ext_type_path: Path.t;
+      ext_type_params: type_expr list;
+      ext_args: constructor_arguments;
+      ext_ret_type: type_expr option;
+      ext_private: private_flag;
+      ext_loc: Location.t;
+      ext_attributes: Parsetree.attributes; }
+
 and type_transparence =
     Type_public      (* unrestricted expansion *)
   | Type_new         (* "new" type *)
   | Type_private     (* private type *)
 
-type exception_declaration =
-    { exn_args: constructor_arguments;
-      exn_loc: Location.t;
-      exn_attributes: Parsetree.attributes;
-     }
-
 (* Type expressions for the class language *)
 
 module Concr = Set.Make(OrderedString)
@@ -278,7 +283,7 @@ and signature = signature_item list
 and signature_item =
     Sig_value of Ident.t * value_description
   | Sig_type of Ident.t * type_declaration * rec_status
-  | Sig_exception of Ident.t * exception_declaration
+  | Sig_typext of Ident.t * extension_constructor * ext_status
   | Sig_module of Ident.t * module_declaration * rec_status
   | Sig_modtype of Ident.t * modtype_declaration
   | Sig_class of Ident.t * class_declaration * rec_status
@@ -302,3 +307,8 @@ and rec_status =
     Trec_not                            (* not recursive *)
   | Trec_first                          (* first in a recursive group *)
   | Trec_next                           (* not first in a recursive group *)
+
+and ext_status =
+    Text_first                     (* first constructor of an extension *)
+  | Text_next                      (* not first constructor of an extension *)
+  | Text_exception                 (* an exception *)
diff --git a/typing/types.mli b/typing/types.mli
index d268ddafa7..9fc3d0dc14 100644
--- a/typing/types.mli
+++ b/typing/types.mli
@@ -122,7 +122,8 @@ type constructor_description =
 and constructor_tag =
     Cstr_constant of int                (* Constant constructor (an int) *)
   | Cstr_block of int                   (* Regular constructor (a block) *)
-  | Cstr_exception of Path.t * Location.t (* Exception constructor *)
+  | Cstr_extension of Path.t * bool     (* Extension constructor
+                                           true if a constant false if a block *)
 
 (* Record label descriptions *)
 
@@ -143,7 +144,7 @@ and record_representation =
     Record_regular                      (* All fields are boxed / tagged *)
   | Record_inlined of int               (* Same, for inlined records *)
   | Record_float                        (* All fields are floats *)
-  | Record_exception of Path.t          (* Inlined record under exception *)
+  | Record_extension of Path.t          (* Inlined record under extension *)
 
 (* Variance *)
 
@@ -184,6 +185,7 @@ and type_kind =
     Type_abstract
   | Type_record of label_declaration list  * record_representation
   | Type_variant of constructor_declaration list
+  | Type_open
 
 and label_declaration =
   {
@@ -207,17 +209,22 @@ and constructor_arguments =
   | Cstr_tuple of type_expr list
   | Cstr_record of Ident.t * label_declaration list
 
+type extension_constructor =
+    {
+      ext_type_path: Path.t;
+      ext_type_params: type_expr list;
+      ext_args: constructor_arguments;
+      ext_ret_type: type_expr option;
+      ext_private: private_flag;
+      ext_loc: Location.t;
+      ext_attributes: Parsetree.attributes;
+    }
+
 and type_transparence =
     Type_public      (* unrestricted expansion *)
   | Type_new         (* "new" type *)
   | Type_private     (* private type *)
 
-type exception_declaration =
-    { exn_args: constructor_arguments;
-      exn_loc: Location.t;
-      exn_attributes: Parsetree.attributes;
-    }
-
 (* Type expressions for the class language *)
 
 module Concr : Set.S with type elt = string
@@ -266,7 +273,7 @@ and signature = signature_item list
 and signature_item =
     Sig_value of Ident.t * value_description
   | Sig_type of Ident.t * type_declaration * rec_status
-  | Sig_exception of Ident.t * exception_declaration
+  | Sig_typext of Ident.t * extension_constructor * ext_status
   | Sig_module of Ident.t * module_declaration * rec_status
   | Sig_modtype of Ident.t * modtype_declaration
   | Sig_class of Ident.t * class_declaration * rec_status
@@ -290,3 +297,8 @@ and rec_status =
     Trec_not                            (* not recursive *)
   | Trec_first                          (* first in a recursive group *)
   | Trec_next                           (* not first in a recursive group *)
+
+and ext_status =
+    Text_first                     (* first constructor in an extension *)
+  | Text_next                      (* not first constructor in an extension *)
+  | Text_exception
diff --git a/typing/typetexp.ml b/typing/typetexp.ml
index b219c814a8..31d4a44f1b 100644
--- a/typing/typetexp.ml
+++ b/typing/typetexp.ml
@@ -21,7 +21,7 @@ open Typedtree
 open Types
 open Ctype
 
-exception Already_bound of Location.t
+exception Already_bound
 
 type error =
     Unbound_type_variable of string
@@ -51,48 +51,118 @@ type error =
   | Unbound_cltype of Longident.t
   | Ill_typed_functor_application of Longident.t
   | Illegal_reference_to_recursive_module
-  | Extension of string
+  | Access_functor_as_structure of Longident.t
 
 exception Error of Location.t * Env.t * error
+exception Error_forward of Location.error
+
+let string_of_cst = function
+  | Const_string(s, _) -> Some s
+  | _ -> None
+
+let string_of_payload = function
+  | PStr[{pstr_desc=Pstr_eval({pexp_desc=Pexp_constant c},_)}] ->
+      string_of_cst c
+  | _ -> None
+
+let rec error_of_extension ext =
+  match ext with
+  | ({txt = ("ocaml.error"|"error") as txt; loc}, p) ->
+    let rec sub_from inner =
+      match inner with
+      | {pstr_desc=Pstr_extension (ext, _)} :: rest ->
+          error_of_extension ext :: sub_from rest
+      | {pstr_loc} :: rest ->
+          (Location.errorf ~loc
+             "Invalid syntax for sub-error of extension '%s'." txt) ::
+            sub_from rest
+      | [] -> []
+    in
+    begin match p with
+    | PStr({pstr_desc=Pstr_eval
+              ({pexp_desc=Pexp_constant(Const_string(msg,_))}, _)}::
+           {pstr_desc=Pstr_eval
+              ({pexp_desc=Pexp_constant(Const_string(if_highlight,_))}, _)}::
+           inner) ->
+        Location.error ~loc ~if_highlight ~sub:(sub_from inner) msg
+    | PStr({pstr_desc=Pstr_eval
+              ({pexp_desc=Pexp_constant(Const_string(msg,_))}, _)}::inner) ->
+        Location.error ~loc ~sub:(sub_from inner) msg
+    | _ -> Location.errorf ~loc "Invalid syntax for extension '%s'." txt
+    end
+  | ({txt; loc}, _) ->
+      Location.errorf ~loc "Uninterpreted extension '%s'." txt
 
 let check_deprecated loc attrs s =
-  if
-    List.exists
-      (function ({txt = "ocaml.deprecated"; _}, _) -> true | _ ->  false)
-      attrs
-  then
-    Location.prerr_warning loc (Warnings.Deprecated s)
+  List.iter
+    (function
+    | ({txt = "ocaml.deprecated"|"deprecated"; _}, p) ->
+      begin match string_of_payload p with
+      | Some txt ->
+          Location.prerr_warning loc (Warnings.Deprecated (s ^ "\n" ^ txt))
+      | None ->
+          Location.prerr_warning loc (Warnings.Deprecated s)
+      end
+    | _ ->  ())
+    attrs
+
+let emit_external_warnings =
+  let open Ast_mapper in
+  {
+    default_mapper with
+    attribute = (fun _ a ->
+        begin match a with
+        | {txt="ocaml.ppwarning"|"ppwarning"},
+          PStr[{pstr_desc=Pstr_eval({pexp_desc=Pexp_constant
+                                         (Const_string (s, _))},_);
+                pstr_loc}] ->
+            Location.prerr_warning pstr_loc (Warnings.Preprocessor s)
+        | _ -> ()
+        end;
+        a
+      )
+  }
+
+
+let warning_scope = ref []
+
+let warning_enter_scope () =
+  warning_scope := ref None :: !warning_scope
+let warning_leave_scope () =
+  match !warning_scope with
+  | [] -> assert false
+  | hd :: tl ->
+      may Warnings.restore !hd;
+      warning_scope := tl
 
 let warning_attribute attrs =
-  let prev_warnings = ref None in
+  let prev_warnings = List.hd !warning_scope in
+  let process loc txt errflag payload =
+    match string_of_payload payload with
+    | Some s ->
+        if !prev_warnings = None then
+          prev_warnings := Some (Warnings.backup ());
+        begin try Warnings.parse_options errflag s
+        with Arg.Bad _ ->
+          Location.prerr_warning loc
+            (Warnings.Attribute_payload
+               (txt, "Ill-formed list of warnings"))
+        end
+    | None ->
+        Location.prerr_warning loc
+          (Warnings.Attribute_payload
+             (txt, "A single string literal is expected"))
+  in
   List.iter
     (function
-      | ({txt = "ocaml.warning"; loc}, payload) ->
-          begin match payload with
-          | PStr [{pstr_desc=Pstr_eval
-                     ({pexp_desc=Pexp_constant(Const_string(s, _))}, _)}] ->
-              if !prev_warnings = None then
-                prev_warnings := Some (Warnings.backup ());
-              begin try Warnings.parse_options false s
-              with Arg.Bad _ ->
-                Location.prerr_warning loc
-                  (Warnings.Attribute_payload
-                     ("ocaml.warning",
-                      "Ill-formed list of warnings"))
-              end
-          | _ ->
-              Location.prerr_warning loc
-                (Warnings.Attribute_payload
-                   ("ocaml.warning",
-                    "A single string literal is expected"))
-          end
+      | ({txt = ("ocaml.warning"|"warning") as txt; loc}, payload) ->
+          process loc txt false payload
+      | ({txt = ("ocaml.warnerror"|"warnerror") as txt; loc}, payload) ->
+          process loc txt true payload
       | _ ->
           ()
     )
-    attrs;
-  !prev_warnings
-
-
+    attrs
 
 type variable_context = int * (string, type_expr) Tbl.t
 
@@ -105,16 +175,22 @@ let instance_list = Ctype.instance_list Env.empty
 let rec narrow_unbound_lid_error : 'a. _ -> _ -> _ -> _ -> 'a =
   fun env loc lid make_error ->
   let check_module mlid =
-    try ignore (Env.lookup_module mlid env)
-    with Not_found ->
-      narrow_unbound_lid_error env loc mlid
-        (fun lid -> Unbound_module lid)
-       | Env.Recmodule ->
-         raise (Error (loc, env, Illegal_reference_to_recursive_module))
+    try ignore (Env.lookup_module true mlid env) with
+    | Not_found ->
+        narrow_unbound_lid_error env loc mlid (fun lid -> Unbound_module lid)
+    | Env.Recmodule ->
+        raise (Error (loc, env, Illegal_reference_to_recursive_module))
   in
   begin match lid with
   | Longident.Lident _ -> ()
-  | Longident.Ldot (mlid, _) -> check_module mlid
+  | Longident.Ldot (mlid, _) ->
+      check_module mlid;
+      let md = Env.find_module (Env.lookup_module true mlid env) env in
+      begin match Env.scrape_alias env md.md_type with
+        Mty_functor _ ->
+          raise (Error (loc, env, Access_functor_as_structure mlid))
+      | _ -> ()
+      end
   | Longident.Lapply (flid, mlid) ->
       check_module flid;
       check_module mlid;
@@ -126,7 +202,7 @@ let find_component lookup make_error env loc lid =
   try
     match lid with
     | Longident.Ldot (Longident.Lident "*predef*", s) ->
-        lookup (Longident.Lident s) Env.initial
+        lookup (Longident.Lident s) Env.initial_safe_string
     | _ -> lookup lid env
   with Not_found ->
     narrow_unbound_lid_error env loc lid make_error
@@ -165,13 +241,17 @@ let find_value env loc lid =
   check_deprecated loc decl.val_attributes (Path.name path);
   r
 
-let find_module env loc lid =
+let lookup_module ?(load=false) env loc lid =
   let (path, decl) as r =
-    find_component (fun lid env -> (Env.lookup_module lid env, ()))
+    find_component (fun lid env -> (Env.lookup_module ~load lid env, ()))
       (fun lid -> Unbound_module lid) env loc lid
-  in
-  (* check_deprecated loc decl.md_attributes (Path.name path); *)
-  path
+  in path
+
+let find_module env loc lid =
+  let path = lookup_module ~load:true env loc lid in
+  let decl = Env.find_module path env in
+  check_deprecated loc decl.md_attributes (Path.name path);
+  (path, decl)
 
 let find_modtype env loc lid =
   let (path, decl) as r =
@@ -258,24 +338,35 @@ let new_global_var ?name () =
 let newvar ?name () =
   newvar ?name:(validate_name name) ()
 
-let enter_type_variable {Location.txt=name; loc} =
-  try
-    if name <> "" && name.[0] = '_' then
-      raise (Error (loc, Env.empty, Invalid_variable_name ("'" ^ name)));
-    let v = Tbl.find name !type_variables in
-    raise (Already_bound loc);
-    v
-  with Not_found ->
-    let v = new_global_var ~name () in
-    type_variables := Tbl.add name v !type_variables;
-    v
-
 let type_variable loc name =
   try
     Tbl.find name !type_variables
   with Not_found ->
     raise(Error(loc, Env.empty, Unbound_type_variable ("'" ^ name)))
 
+let transl_type_param env styp =
+  let loc = styp.ptyp_loc in
+  match styp.ptyp_desc with
+    Ptyp_any ->
+      let ty = new_global_var ~name:"_" () in
+        { ctyp_desc = Ttyp_any; ctyp_type = ty; ctyp_env = env;
+          ctyp_loc = loc; ctyp_attributes = styp.ptyp_attributes; }
+  | Ptyp_var name ->
+      let ty =
+        try
+          if name <> "" && name.[0] = '_' then
+            raise (Error (loc, Env.empty, Invalid_variable_name ("'" ^ name)));
+          ignore (Tbl.find name !type_variables);
+          raise Already_bound
+        with Not_found ->
+          let v = new_global_var ~name () in
+            type_variables := Tbl.add name v !type_variables;
+            v
+      in
+        { ctyp_desc = Ttyp_var name; ctyp_type = ty; ctyp_env = env;
+          ctyp_loc = loc; ctyp_attributes = styp.ptyp_attributes; }
+  | _ -> assert false
+
 let wrap_method ty =
   match (Ctype.repr ty).desc with
     Tpoly _ -> ty
@@ -366,7 +457,7 @@ let rec transl_type env policy styp =
       ctyp (Ttyp_constr (path, lid, args)) constr
   | Ptyp_object (fields, o) ->
       let fields =
-        List.map (fun (s, t) -> (s, transl_poly_type env policy t))
+        List.map (fun (s, a, t) -> (s, a, transl_poly_type env policy t))
           fields
       in
       let ty = newobj (transl_fields loc env policy [] o fields) in
@@ -398,7 +489,7 @@ let rec transl_type env policy styp =
           let (path, decl) = Env.lookup_type lid2 env in
           (path, decl, false)
         with Not_found ->
-          raise(Error(styp.ptyp_loc, env, Unbound_class lid.txt))
+          ignore (find_class env styp.ptyp_loc lid.txt); assert false
       in
       if List.length stl <> decl.type_arity then
         raise(Error(styp.ptyp_loc, env,
@@ -508,7 +599,7 @@ let rec transl_type env policy styp =
           Hashtbl.add hfields h (l,f)
       in
       let add_field = function
-          Rtag (l, c, stl) ->
+          Rtag (l, attrs, c, stl) ->
             name := None;
             let tl = List.map (transl_type env policy) stl in
             let f = match present with
@@ -523,7 +614,7 @@ let rec transl_type env policy styp =
                       Rpresent (Some st.ctyp_type)
             in
             add_typed_field styp.ptyp_loc l f;
-              Ttag (l,c,tl)
+              Ttag (l,attrs,c,tl)
         | Rinherit sty ->
             let cty = transl_type env policy sty in
             let ty = cty.ctyp_type in
@@ -629,13 +720,13 @@ let rec transl_type env policy styp =
                        List.map (fun (_,cty) -> cty.ctyp_type) ptys))
       in
       ctyp (Ttyp_package {
-            pack_name = path;
+            pack_path = path;
             pack_type = mty.mty_type;
             pack_fields = ptys;
             pack_txt = p;
            }) ty
-  | Ptyp_extension (s, _arg) ->
-      raise (Error (s.loc, env, Extension s.txt))
+  | Ptyp_extension ext ->
+      raise (Error_forward (error_of_extension ext))
 
 and transl_poly_type env policy t =
   transl_type env policy (Ast_helper.Typ.force_poly t)
@@ -648,7 +739,7 @@ and transl_fields loc env policy seen o =
       | Open, Univars -> new_pre_univar ()
       | Open, _ -> newvar ()
       end
-  | (s, ty1) :: l ->
+  | (s, _attrs, ty1) :: l ->
       if List.mem s seen then raise (Error (loc, env, Repeated_method_label s));
       let ty2 = transl_fields loc env policy (s :: seen) o l in
       newty (Tfield (s, Fpresent, ty1.ctyp_type, ty2))
@@ -903,14 +994,16 @@ let report_error env ppf = function
       fprintf ppf "Ill-typed functor application %a" longident lid
   | Illegal_reference_to_recursive_module ->
       fprintf ppf "Illegal recursive module reference"
-  | Extension s ->
-      fprintf ppf "Uninterpreted extension '%s'." s
+  | Access_functor_as_structure lid ->
+      fprintf ppf "The module %a is a functor, not a structure" longident lid
 
 let () =
   Location.register_error_of_exn
     (function
       | Error (loc, env, err) ->
         Some (Location.error_of_printer loc (report_error env) err)
+      | Error_forward err ->
+        Some err
       | _ ->
         None
     )
diff --git a/typing/typetexp.mli b/typing/typetexp.mli
index 1d90eb7591..7bff403f0f 100644
--- a/typing/typetexp.mli
+++ b/typing/typetexp.mli
@@ -25,14 +25,15 @@ val transl_simple_type_delayed:
 val transl_type_scheme:
         Env.t -> Parsetree.core_type -> Typedtree.core_type
 val reset_type_variables: unit -> unit
-val enter_type_variable: string Location.loc -> type_expr
 val type_variable: Location.t -> string -> type_expr
+val transl_type_param:
+  Env.t -> Parsetree.core_type -> Typedtree.core_type
 
 type variable_context
 val narrow: unit -> variable_context
 val widen: variable_context -> unit
 
-exception Already_bound of Location.t
+exception Already_bound
 
 type error =
     Unbound_type_variable of string
@@ -62,7 +63,7 @@ type error =
   | Unbound_cltype of Longident.t
   | Ill_typed_functor_application of Longident.t
   | Illegal_reference_to_recursive_module
-  | Extension of string
+  | Access_functor_as_structure of Longident.t
 
 exception Error of Location.t * Env.t * error
 
@@ -95,7 +96,9 @@ val find_value:
 val find_class:
     Env.t -> Location.t -> Longident.t -> Path.t * class_declaration
 val find_module:
-    Env.t -> Location.t -> Longident.t -> Path.t
+    Env.t -> Location.t -> Longident.t -> Path.t * module_declaration
+val lookup_module:
+    ?load:bool -> Env.t -> Location.t -> Longident.t -> Path.t
 val find_modtype:
     Env.t -> Location.t -> Longident.t -> Path.t * modtype_declaration
 val find_class_type:
@@ -112,4 +115,10 @@ val spellcheck_simple:
 
 val check_deprecated: Location.t -> Parsetree.attributes -> string -> unit
 
-val warning_attribute: Parsetree.attributes -> Warnings.state option
+val warning_enter_scope: unit -> unit
+val warning_leave_scope: unit -> unit
+val warning_attribute: Parsetree.attributes -> unit
+
+val error_of_extension: Parsetree.extension -> Location.error
+
+val emit_external_warnings: Ast_mapper.mapper
diff --git a/utils/clflags.ml b/utils/clflags.ml
index 829393a00d..f582a46559 100644
--- a/utils/clflags.ml
+++ b/utils/clflags.ml
@@ -43,6 +43,7 @@ and noprompt = ref false                (* -noprompt *)
 and nopromptcont = ref false            (* -nopromptcont *)
 and init_file = ref (None : string option)   (* -init *)
 and noinit = ref false                  (* -noinit *)
+and open_modules = ref []               (* -open *)
 and use_prims = ref ""                  (* -use-prims ... *)
 and use_runtime = ref ""                (* -use-runtime ... *)
 and principal = ref false               (* -principal *)
@@ -58,6 +59,7 @@ and dllpaths = ref ([] : string list)   (* -dllpath *)
 and make_package = ref false            (* -pack *)
 and for_package = ref (None: string option) (* -for-pack *)
 and error_size = ref 500                (* -error-size *)
+and float_const_prop = ref true         (* -no-float-const-prop *)
 and transparent_modules = ref false     (* -trans-mod *)
 let dump_source = ref false             (* -dsource *)
 let dump_parsetree = ref false          (* -dparsetree *)
@@ -72,6 +74,7 @@ let optimize_for_speed = ref true       (* -compact *)
 
 and dump_cmm = ref false                (* -dcmm *)
 let dump_selection = ref false          (* -dsel *)
+let dump_cse = ref false                (* -dcse *)
 let dump_live = ref false               (* -dlive *)
 let dump_spill = ref false              (* -dspill *)
 let dump_split = ref false              (* -dsplit *)
@@ -105,3 +108,4 @@ let dlcode = ref true (* not -nodynlink *)
 let runtime_variant = ref "";;      (* -runtime-variant *)
 
 let keep_locs = ref false              (* -keep-locs *)
+let unsafe_string = ref true;;         (* -safe-string / -unsafe-string *)
diff --git a/utils/clflags.mli b/utils/clflags.mli
index 876776acdb..5474157c37 100644
--- a/utils/clflags.mli
+++ b/utils/clflags.mli
@@ -23,11 +23,12 @@ val debug : bool ref
 val fast : bool ref
 val link_everything : bool ref
 val custom_runtime : bool ref
-val bytecode_compatible_32: bool ref
+val bytecode_compatible_32 : bool ref
 val output_c_object : bool ref
 val all_ccopts : string list ref
 val classic : bool ref
 val nopervasives : bool ref
+val open_modules : string list ref
 val preprocessor : string option ref
 val all_ppx : string list ref
 val annotations : bool ref
@@ -55,6 +56,7 @@ val dllpaths : string list ref
 val make_package : bool ref
 val for_package : string option ref
 val error_size : int ref
+val float_const_prop : bool ref
 val transparent_modules : bool ref
 val dump_source : bool ref
 val dump_parsetree : bool ref
@@ -67,6 +69,7 @@ val keep_asm_file : bool ref
 val optimize_for_speed : bool ref
 val dump_cmm : bool ref
 val dump_selection : bool ref
+val dump_cse : bool ref
 val dump_live : bool ref
 val dump_spill : bool ref
 val dump_split : bool ref
@@ -88,3 +91,4 @@ val dlcode : bool ref
 val runtime_variant : string ref
 val force_slash : bool ref
 val keep_locs : bool ref
+val unsafe_string : bool ref
diff --git a/utils/config.mlp b/utils/config.mlp
index 209f90ce15..db6fd20ed0 100644
--- a/utils/config.mlp
+++ b/utils/config.mlp
@@ -50,14 +50,14 @@ let mkmaindll = "%%MKMAINDLL%%"
 
 let exec_magic_number = "Caml1999X011"
 and cmi_magic_number = "Caml1999I017"
-and cmo_magic_number = "Caml1999O009"
-and cma_magic_number = "Caml1999A010"
-and cmx_magic_number = "Caml1999Y012"
-and cmxa_magic_number = "Caml1999Z011"
+and cmo_magic_number = "Caml1999O010"
+and cma_magic_number = "Caml1999A011"
+and cmx_magic_number = "Caml1999Y014"
+and cmxa_magic_number = "Caml1999Z013"
 and ast_impl_magic_number = "Caml1999M016"
 and ast_intf_magic_number = "Caml1999N015"
-and cmxs_magic_number = "Caml2007D001"
-and cmt_magic_number = "Caml2012T003"
+and cmxs_magic_number = "Caml2007D002"
+and cmt_magic_number = "Caml2012T004"
 
 let load_path = ref ([] : string list)
 
diff --git a/utils/consistbl.ml b/utils/consistbl.ml
index 4bc42dc5b0..6adaf41122 100644
--- a/utils/consistbl.ml
+++ b/utils/consistbl.ml
@@ -40,8 +40,19 @@ let set tbl name crc source = Hashtbl.add tbl name (crc, source)
 
 let source tbl name = snd (Hashtbl.find tbl name)
 
-let extract tbl =
-  Hashtbl.fold (fun name (crc, auth) accu -> (name, crc) :: accu) tbl []
+let extract l tbl =
+  List.fold_left
+    (fun assc name ->
+     try
+       ignore (List.assoc name assc);
+       assc
+     with Not_found ->
+       try
+         let (crc, _) = Hashtbl.find tbl name in
+           (name, Some crc) :: assc
+       with Not_found ->
+         (name, None) :: assc)
+    [] l
 
 let filter p tbl =
   let to_remove = ref [] in
diff --git a/utils/consistbl.mli b/utils/consistbl.mli
index d3f2afcec9..012bd734fa 100644
--- a/utils/consistbl.mli
+++ b/utils/consistbl.mli
@@ -40,9 +40,10 @@ val source: t -> string -> string
          if the latter has an associated CRC in [tbl].
          Raise [Not_found] otherwise. *)
 
-val extract: t -> (string * Digest.t) list
-      (* Return all bindings ([name], [crc]) contained in the given
-         table. *)
+val extract: string list -> t -> (string * Digest.t option) list
+      (* [extract tbl names] returns an associative list mapping each string
+         in [names] to the CRC associated with it in [tbl]. If no CRC is
+         associated with a name then it is mapped to [None]. *)
 
 val filter: (string -> bool) -> t -> unit
       (* [filter pred tbl] removes from [tbl] table all (name, CRC) pairs
diff --git a/utils/misc.ml b/utils/misc.ml
index 1a2a871394..898880cb07 100644
--- a/utils/misc.ml
+++ b/utils/misc.ml
@@ -124,14 +124,14 @@ let create_hashtable size init =
 (* File copy *)
 
 let copy_file ic oc =
-  let buff = String.create 0x1000 in
+  let buff = Bytes.create 0x1000 in
   let rec copy () =
     let n = input ic buff 0 0x1000 in
     if n = 0 then () else (output oc buff 0 n; copy())
   in copy()
 
 let copy_file_chunk ic oc len =
-  let buff = String.create 0x1000 in
+  let buff = Bytes.create 0x1000 in
   let rec copy n =
     if n <= 0 then () else begin
       let r = input ic buff 0 (min n 0x1000) in
@@ -141,23 +141,13 @@ let copy_file_chunk ic oc len =
 
 let string_of_file ic =
   let b = Buffer.create 0x10000 in
-  let buff = String.create 0x1000 in
+  let buff = Bytes.create 0x1000 in
   let rec copy () =
     let n = input ic buff 0 0x1000 in
     if n = 0 then Buffer.contents b else
-      (Buffer.add_substring b buff 0 n; copy())
+      (Buffer.add_subbytes b buff 0 n; copy())
   in copy()
 
-
-
-(* Reading from a channel *)
-
-let input_bytes ic n =
-  let result = String.create n in
-  really_input ic result 0 n;
-  result
-;;
-
 (* Integer operations *)
 
 let rec log2 n =
@@ -226,26 +216,27 @@ let for4 (_,_,_,x) = x
 
 
 module LongString = struct
-  type t = string array
+  type t = bytes array
 
   let create str_size =
     let tbl_size = str_size / Sys.max_string_length + 1 in
-    let tbl = Array.make tbl_size "" in
+    let tbl = Array.make tbl_size Bytes.empty in
     for i = 0 to tbl_size - 2 do
-      tbl.(i) <- String.create Sys.max_string_length;
+      tbl.(i) <- Bytes.create Sys.max_string_length;
     done;
-    tbl.(tbl_size - 1) <- String.create (str_size mod Sys.max_string_length);
+    tbl.(tbl_size - 1) <- Bytes.create (str_size mod Sys.max_string_length);
     tbl
 
   let length tbl =
     let tbl_size = Array.length tbl in
-    Sys.max_string_length * (tbl_size - 1) + String.length tbl.(tbl_size - 1)
+    Sys.max_string_length * (tbl_size - 1) + Bytes.length tbl.(tbl_size - 1)
 
   let get tbl ind =
-    tbl.(ind / Sys.max_string_length).[ind mod Sys.max_string_length]
+    Bytes.get tbl.(ind / Sys.max_string_length) (ind mod Sys.max_string_length)
 
   let set tbl ind c =
-    tbl.(ind / Sys.max_string_length).[ind mod Sys.max_string_length] <- c
+    Bytes.set tbl.(ind / Sys.max_string_length) (ind mod Sys.max_string_length)
+              c
 
   let blit src srcoff dst dstoff len =
     for i = 0 to len - 1 do
@@ -257,14 +248,14 @@ module LongString = struct
       output_char oc (get tbl i)
     done
 
-  let unsafe_blit_to_string src srcoff dst dstoff len =
+  let unsafe_blit_to_bytes src srcoff dst dstoff len =
     for i = 0 to len - 1 do
-      String.unsafe_set dst (dstoff + i) (get src (srcoff + i))
+      Bytes.unsafe_set dst (dstoff + i) (get src (srcoff + i))
     done
 
   let input_bytes ic len =
     let tbl = create len in
-    Array.iter (fun str -> really_input ic str 0 (String.length str)) tbl;
+    Array.iter (fun str -> really_input ic str 0 (Bytes.length str)) tbl;
     tbl
 end
 
diff --git a/utils/misc.mli b/utils/misc.mli
index 67316365e1..4a3c84b2d9 100644
--- a/utils/misc.mli
+++ b/utils/misc.mli
@@ -66,11 +66,6 @@ val copy_file_chunk: in_channel -> out_channel -> int -> unit
 val string_of_file: in_channel -> string
         (* [string_of_file ic] reads the contents of file [ic] and copies
            them to a string. It stops when encountering EOF on [ic]. *)
-val input_bytes : in_channel -> int -> string;;
-        (* [input_bytes ic n] reads [n] bytes from [ic] and returns them
-           in a new string.  It raises [End_of_file] if EOF is encountered
-           before all the bytes are read. *)
-
 val log2: int -> int
         (* [log2 n] returns [s] such that [n = 1 lsl s]
            if [n] is a power of 2*)
@@ -124,14 +119,14 @@ val for4: 'a * 'b * 'c * 'd -> 'd
 
 module LongString :
   sig
-    type t = string array
+    type t = bytes array
     val create : int -> t
     val length : t -> int
     val get : t -> int -> char
     val set : t -> int -> char -> unit
     val blit : t -> int -> t -> int -> int -> unit
     val output : out_channel -> t -> int -> int -> unit
-    val unsafe_blit_to_string : t -> int -> string -> int -> int -> unit
+    val unsafe_blit_to_bytes : t -> int -> bytes -> int -> int -> unit
     val input_bytes : in_channel -> int -> t
   end
 
diff --git a/utils/warnings.ml b/utils/warnings.ml
index 58d2753962..2dc26a3504 100644
--- a/utils/warnings.ml
+++ b/utils/warnings.ml
@@ -39,7 +39,7 @@ type t =
   | Without_principality of string          (* 19 *)
   | Unused_argument                         (* 20 *)
   | Nonreturning_statement                  (* 21 *)
-  | Camlp4 of string                        (* 22 *)
+  | Preprocessor of string                  (* 22 *)
   | Useless_record_with                     (* 23 *)
   | Bad_module_name of string               (* 24 *)
   | All_clauses_guarded                     (* 25 *)
@@ -55,7 +55,7 @@ type t =
   | Unused_for_index of string              (* 35 *)
   | Unused_ancestor of string               (* 36 *)
   | Unused_constructor of string * bool * bool  (* 37 *)
-  | Unused_exception of string * bool       (* 38 *)
+  | Unused_extension of string * bool * bool    (* 38 *)
   | Unused_rec_flag                         (* 39 *)
   | Name_out_of_scope of string * string list * bool (* 40 *)
   | Ambiguous_name of string list * string list *  bool    (* 41 *)
@@ -66,6 +66,7 @@ type t =
   | Bad_env_variable of string * string     (* 46 *)
   | Attribute_payload of string * string    (* 47 *)
   | Eliminated_optional_arguments of string list (* 48 *)
+  | No_cmi_file of string                   (* 49 *)
 ;;
 
 (* If you remove a warning, leave a hole in the numbering.  NEVER change
@@ -96,7 +97,7 @@ let number = function
   | Without_principality _ -> 19
   | Unused_argument -> 20
   | Nonreturning_statement -> 21
-  | Camlp4 _ -> 22
+  | Preprocessor _ -> 22
   | Useless_record_with -> 23
   | Bad_module_name _ -> 24
   | All_clauses_guarded -> 25
@@ -112,7 +113,7 @@ let number = function
   | Unused_for_index _ -> 35
   | Unused_ancestor _ -> 36
   | Unused_constructor _ -> 37
-  | Unused_exception _ -> 38
+  | Unused_extension _ -> 38
   | Unused_rec_flag -> 39
   | Name_out_of_scope _ -> 40
   | Ambiguous_name _ -> 41
@@ -123,9 +124,10 @@ let number = function
   | Bad_env_variable _ -> 46
   | Attribute_payload _ -> 47
   | Eliminated_optional_arguments _ -> 48
+  | No_cmi_file _ -> 49
 ;;
 
-let last_warning_number = 48
+let last_warning_number = 49
 (* Must be the max number returned by the [number] function. *)
 
 let letter = function
@@ -286,7 +288,7 @@ let message = function
   | Unused_argument -> "this argument will not be used by the function."
   | Nonreturning_statement ->
       "this statement never returns (or has an unsound type.)"
-  | Camlp4 s -> s
+  | Preprocessor s -> s
   | Useless_record_with ->
       "all the fields are explicitly listed in this record:\n\
        the 'with' clause is useless."
@@ -320,12 +322,15 @@ let message = function
       "constructor " ^ s ^
       " is never used to build values.\n\
         Its type is exported as a private type."
-  | Unused_exception (s, false) ->
-      "unused exception constructor " ^ s ^ "."
-  | Unused_exception (s, true) ->
-      "exception constructor " ^ s ^
-      " is never raised or used to build values.\n\
+  | Unused_extension (s, false, false) -> "unused extension constructor " ^ s ^ "."
+  | Unused_extension (s, true, _) ->
+      "extension constructor " ^ s ^
+      " is never used to build values.\n\
         (However, this constructor appears in patterns.)"
+  | Unused_extension (s, false, true) ->
+      "extension constructor " ^ s ^
+      " is never used to build values.\n\
+        It is exported or rebound as a private extension."
   | Unused_rec_flag ->
       "unused rec flag."
   | Name_out_of_scope (ty, [nm], false) ->
@@ -366,6 +371,8 @@ let message = function
       Printf.sprintf "implicit elimination of optional argument%s %s"
         (if List.length sl = 1 then "" else "s")
         (String.concat ", " sl)
+  | No_cmi_file s ->
+      "no cmi file was found in path for module " ^ s
 ;;
 
 let nerrors = ref 0;;
@@ -426,7 +433,7 @@ let descriptions =
    19, "Type without principality.";
    20, "Unused function argument.";
    21, "Non-returning statement.";
-   22, "Camlp4 warning.";
+   22, "Proprocessor warning.";
    23, "Useless record \"with\" clause.";
    24, "Bad module name: the source file name is not a valid OCaml module \
         name.";
@@ -449,7 +456,7 @@ let descriptions =
    35, "Unused for-loop index.";
    36, "Unused ancestor variable.";
    37, "Unused constructor.";
-   38, "Unused exception constructor.";
+   38, "Unused extension constructor.";
    39, "Unused rec flag.";
    40, "Constructor or label name used out of scope.";
    41, "Ambiguous constructor or label name.";
@@ -457,9 +464,10 @@ let descriptions =
    43, "Nonoptional label applied as optional.";
    44, "Open statement shadows an already defined identifier.";
    45, "Open statement shadows an already defined label or constructor.";
-   46, "Illegal environment variable";
-   47, "Illegal attribute payload";
-   48, "Implicit elimination of optional arguments";
+   46, "Illegal environment variable.";
+   47, "Illegal attribute payload.";
+   48, "Implicit elimination of optional arguments.";
+   49, "Absent cmi file when looking up module alias.";
   ]
 ;;
 
diff --git a/utils/warnings.mli b/utils/warnings.mli
index 05bf66bdea..edfd732c31 100644
--- a/utils/warnings.mli
+++ b/utils/warnings.mli
@@ -34,7 +34,7 @@ type t =
   | Without_principality of string          (* 19 *)
   | Unused_argument                         (* 20 *)
   | Nonreturning_statement                  (* 21 *)
-  | Camlp4 of string                        (* 22 *)
+  | Preprocessor of string                  (* 22 *)
   | Useless_record_with                     (* 23 *)
   | Bad_module_name of string               (* 24 *)
   | All_clauses_guarded                     (* 25 *)
@@ -50,7 +50,7 @@ type t =
   | Unused_for_index of string              (* 35 *)
   | Unused_ancestor of string               (* 36 *)
   | Unused_constructor of string * bool * bool (* 37 *)
-  | Unused_exception of string * bool       (* 38 *)
+  | Unused_extension of string * bool * bool   (* 38 *)
   | Unused_rec_flag                         (* 39 *)
   | Name_out_of_scope of string * string list * bool   (* 40 *)
   | Ambiguous_name of string list * string list * bool (* 41 *)
@@ -61,6 +61,7 @@ type t =
   | Bad_env_variable of string * string     (* 46 *)
   | Attribute_payload of string * string    (* 47 *)
   | Eliminated_optional_arguments of string list (* 48 *)
+  | No_cmi_file of string                   (* 49 *)
 ;;
 
 val parse_options : bool -> string -> unit;;
diff --git a/yacc/defs.h b/yacc/defs.h
index 0a823874f6..32114ea568 100644
--- a/yacc/defs.h
+++ b/yacc/defs.h
@@ -312,45 +312,45 @@ extern action *add_reductions(int stateno, register action *actions);
 extern action *add_reduce(register action *actions, register int ruleno, register int symbol);
 extern void closure (short int *nucleus, int n);
 extern void create_symbol_table (void);
-extern void default_action_error (void);
+extern void default_action_error (void) Noreturn;
 extern void done (int k) Noreturn;
-extern void entry_without_type (char *s);
-extern void fatal (char *msg);
+extern void entry_without_type (char *s) Noreturn;
+extern void fatal (char *msg) Noreturn;
 extern void finalize_closure (void);
 extern void free_parser (void);
 extern void free_symbol_table (void);
 extern void free_symbols (void);
-extern void illegal_character (char *c_cptr);
-extern void illegal_token_ref (int i, char *name);
+extern void illegal_character (char *c_cptr) Noreturn;
+extern void illegal_token_ref (int i, char *name) Noreturn;
 extern void lalr (void);
 extern void lr0 (void);
 extern void make_parser (void);
-extern void no_grammar (void);
-extern void no_space (void);
-extern void open_error (char *filename);
+extern void no_grammar (void) Noreturn;
+extern void no_space (void) Noreturn;
+extern void open_error (char *filename) Noreturn;
 extern void output (void);
-extern void over_unionized (char *u_cptr);
+extern void over_unionized (char *u_cptr) Noreturn;
 extern void prec_redeclared (void);
-extern void polymorphic_entry_point(char *s);
+extern void polymorphic_entry_point(char *s) Noreturn;
 extern void reader (void);
 extern void reflexive_transitive_closure (unsigned int *R, int n);
 extern void reprec_warning (char *s);
 extern void retyped_warning (char *s);
 extern void revalued_warning (char *s);
 extern void set_first_derives (void);
-extern void syntax_error (int st_lineno, char *st_line, char *st_cptr) Noreturn, terminal_lhs (int s_lineno);
-extern void terminal_start (char *s);
-extern void tokenized_start (char *s);
-extern void too_many_entries (void);
+extern void syntax_error (int st_lineno, char *st_line, char *st_cptr) Noreturn, terminal_lhs (int s_lineno) Noreturn;
+extern void terminal_start (char *s) Noreturn;
+extern void tokenized_start (char *s) Noreturn;
+extern void too_many_entries (void) Noreturn;
 extern void undefined_goal (char *s);
 extern void undefined_symbol (char *s);
-extern void unexpected_EOF (void);
-extern void unknown_rhs (int i);
-extern void unterminated_action (int a_lineno, char *a_line, char *a_cptr);
-extern void unterminated_comment (int c_lineno, char *c_line, char *c_cptr);
-extern void unterminated_string (int s_lineno, char *s_line, char *s_cptr);
-extern void unterminated_text (int t_lineno, char *t_line, char *t_cptr);
-extern void unterminated_union (int u_lineno, char *u_line, char *u_cptr);
-extern void used_reserved (char *s);
+extern void unexpected_EOF (void) Noreturn;
+extern void unknown_rhs (int i) Noreturn;
+extern void unterminated_action (int a_lineno, char *a_line, char *a_cptr) Noreturn;
+extern void unterminated_comment (int c_lineno, char *c_line, char *c_cptr) Noreturn;
+extern void unterminated_string (int s_lineno, char *s_line, char *s_cptr) Noreturn;
+extern void unterminated_text (int t_lineno, char *t_line, char *t_cptr) Noreturn;
+extern void unterminated_union (int u_lineno, char *u_line, char *u_cptr) Noreturn;
+extern void used_reserved (char *s) Noreturn;
 extern void verbose (void);
 extern void write_section (char **section);
diff --git a/yacc/main.c b/yacc/main.c
index d2f329310d..9388b9d1a8 100644
--- a/yacc/main.c
+++ b/yacc/main.c
@@ -55,11 +55,7 @@ char *text_file_name;
 char *union_file_name;
 char *verbose_file_name;
 
-#if defined(__OpenBSD__) || defined(__NetBSD__) || defined(__FreeBSD__) || defined(__DragonFly__) || (__APPLE__)
-#define HAVE_MKSTEMP
-#endif
-
-#ifdef HAVE_MKSTEMP
+#ifdef HAS_MKSTEMP
 int action_fd = -1, entry_fd = -1, text_fd = -1, union_fd = -1;
 #endif
 
@@ -101,7 +97,7 @@ char  *rassoc;
 short **derives;
 char *nullable;
 
-#if !defined(HAVE_MKSTEMP)
+#if !defined(HAS_MKSTEMP)
 extern char *mktemp(char *);
 #endif
 #ifndef NO_UNIX
@@ -111,7 +107,7 @@ extern char *getenv(const char *);
 
 void done(int k)
 {
-#ifdef HAVE_MKSTEMP
+#ifdef HAS_MKSTEMP
     if (action_fd != -1)
        unlink(action_file_name);
     if (entry_fd != -1)
@@ -325,7 +321,7 @@ void create_file_names(void)
     text_file_name[len + 5] = 't';
     union_file_name[len + 5] = 'u';
 
-#ifdef HAVE_MKSTEMP
+#ifdef HAS_MKSTEMP
     action_fd = mkstemp(action_file_name);
     if (action_fd == -1)
         open_error(action_file_name);
@@ -384,7 +380,7 @@ void open_files(void)
             open_error(input_file_name);
     }
 
-#ifdef HAVE_MKSTEMP
+#ifdef HAS_MKSTEMP
     action_file = fdopen(action_fd, "w");
 #else
     action_file = fopen(action_file_name, "w");
@@ -392,7 +388,7 @@ void open_files(void)
     if (action_file == 0)
         open_error(action_file_name);
 
-#ifdef HAVE_MKSTEMP
+#ifdef HAS_MKSTEMP
     entry_file = fdopen(entry_fd, "w");
 #else
     entry_file = fopen(entry_file_name, "w");
@@ -400,7 +396,7 @@ void open_files(void)
     if (entry_file == 0)
         open_error(entry_file_name);
 
-#ifdef HAVE_MKSTEMP
+#ifdef HAS_MKSTEMP
     text_file = fdopen(text_fd, "w");
 #else
     text_file = fopen(text_file_name, "w");
@@ -420,7 +416,7 @@ void open_files(void)
         defines_file = fopen(defines_file_name, "w");
         if (defines_file == 0)
             open_error(defines_file_name);
-#ifdef HAVE_MKSTEMP
+#ifdef HAS_MKSTEMP
         union_file = fdopen(union_fd, "w");
 #else
         union_file = fopen(union_file_name, "w");
author	Alain Frisch <alain@frisch.fr>	2014-08-07 16:07:55 +0000
committer	Alain Frisch <alain@frisch.fr>	2014-08-07 16:07:55 +0000
commit	50f47df33a6061e1acd015dbb0dcffcdd51e0f2f (patch)
tree	568e704c3ff8e8e055573cc44efa4d522b0341f1
parent	9e23ded0d195e861ad9ed7d0801ed1c3a0ed34e3 (diff)
parent	047e09748c91e1d8f80b51edfc33de76fbfc57da (diff)
download	ocaml-50f47df33a6061e1acd015dbb0dcffcdd51e0f2f.tar.gz